I have an input box asking user to enter a date. How do I let the program know to stop if the user click cancel or close the input dialog instead of press okay.

Something likeif str=vbCancel then exit sub

Currently, user can hit OK or Cancel but the program still runs

str = InputBox(Prompt:="Enter Date MM/DD/YYY", _ Title:="Date Confirmation", Default:=Date)

I'm trying stream data from Python to an opened excel file. I've been using openpyxl to do this. Here's the code that I've so far,

from openpyxl import load_workbookwb = load_workbook('some_data.xlsx')ws = wb['MySheet']while True:    current_val = some_method_that_gives_data()    ws['A1'].value = current_val    wb.save('some_data.xlsx')

The functionality I'm trying to achieve is to be able to update the excel data in realtime from Python. The problem is updating data this way gives permission error if the file is already open in MS-Excel (but I want to be able to update it while being open in other apps).

I guess this has more to do with file handling at the OS level, but I'm not able to figure out the solution for this issue.

I have a very simple OFFSET Function that i connect to a scroll bar to scroll through data. =OFFSET(A$2,$A$48,0). When I filter the data in cells A2-A45 to select only a certain category, i'd like the scrolling of the OFFSET function to skip the hidden cells and only scroll through the data that is still visible after filtering.

Sub AddVisibleName()    Dim rVisible As Range    Dim lLastRow As Long    lLastRow = Range("A"& Rows.Count).End(xlUp).Row    Set rVisible = Range("A2:A45"& lLastRow).SpecialCells(xlCellTypeVisible)    ActiveWorkbook.Names.Add Name:="VisibleRange", RefersTo:=rVisibleEnd Sub

The code above creates the range "VisibleRange" that only has the values of the non hidden cells shown in it. Is there a way to incorporate this into the OFFSET function?

Any other simpler methods of achieving what i'd like are also welcomed

Thanks

I am building a drug information app and I intend to write down the info first in a word document like this and then have the app show only 2 labels on is the left column(drug name) and the other is the right column(drug info) then the user clicks next and both labels show the second row and so one!

I am not strict with using this method if there are other easier methods I am open to try.I am a complete novice I manily use app building sites that require no coding. so if you can just provide a concept to work with that would be great.

enter image description here

my goal is to delete rows with column 3 with the cell value that has inventory (>0) and column 4 that has the cell value TRUE in the current sheet. I tried to use the code to this website and I'm pretty sure I did something wrong where it says ActiveSheet.DataBodyRange.SpecialCells(xlCellTypeVisible).Delete

Public Sub FilterStock()    ActiveSheet.Range("A1").AutoFilter Field:=4, Criteria1:="TRUE"    ActiveSheet.Range("A1").AutoFilter Field:=3, Criteria1:=">0"    Application.DisplayAlerts = False        ActiveSheet.DataBodyRange.SpecialCells(xlCellTypeVisible).Delete    Application.DisplayAlerts = True    ActiveSheet.AutoFilter.ShowAllDataEnd Sub

I have something like this

I'd like to assign a value (1,2,3,...) to the third column based on the other columns. For example, the value 1 would be assigne to the first row of each group in the second column to end up like this

I've tried with AutoFill and DataSeries but I can't manage, tahnks for your help!

PFA link to Excel file and Example Picture. I want to create a VBA program that will create 3 columns with the data extracted. The columns will have the same name as the columns where the data is been extracted from, in this case "UWI", "X", AND "Y". This are directional surveys, I want to get the midpoint of each of them. This midpoint can be found in the same row as the closest match to the average of the first and last value of "Measured Depth" when the deviation angle is greater than 87 degrees and lower than 93 degrees for each of the directional surveys. There are around 2800 of them, each one of them starts with "Deviation Angle" and "Measured Depth" equal to 0 which could be used as a guide to find the last point, and the first point could be found as the first value when the deviation angle starts at 87 degrees and stays closer to 90 degrees atleast thats how I thought about it so far.

https://drive.google.com/file/d/1i0gM_BsWlNZeFk_w3-WRUod81lwZDLmJ/view?usp=sharing

For r=1 to 100    If Cells(8,r)>87 Then    Num1=Cells(5,r)    End If    If Cells(8,r)=0 Then        Num2 = Cells(8,r-1)        Cells(9,r-1)=(Num1+Num2)/2    End ifNext rEnd Sub

I have an extensive excel pivot table macro that creates 6 pivot tables. Whenever I try to run the macro I receive an error (5), invalid procurement or argument. I have looked through various forums and cannot find a fix for this error. The error resides somewhere in lines 3-6. If someone could point me in the right direction I would really appreciate it.I am not skilled in the VBA language.

Range("A5").SelectSheets.AddActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _"All Open Tool Records 05-22-20!R1C1:R4750C27", Version:= _    xlPivotTableVersion10).CreatePivotTable TableDestination:="Sheet1!R3C1", _    TableName:="PivotTable1", DefaultVersion:=xlPivotTableVersion10Sheets("Sheet1").SelectCells(3, 1).SelectWith ActiveSheet.PivotTables("PivotTable1").PivotFields("Department")    .Orientation = xlRowField    .Position = 1End With

This is the source array:

The final array should look like this:

My code is simple, I just want to do this:

    Set iShell = WScript.CreateObject("WScript.Shell")    xRepeat:' ** Activate a specify Internet Explorer 11 Window already open (by PID)    iShell.SendKeys "{TAB}"    iShell.SendKeys "{CTRL + C}"    iShell.SendKeys "{TAB} {TAB} {TAB} {TAB}"    iShell.SendKeys "{CTRL+ V}"    iShell.SendKeys "{TAB} {TAB} {TAB} {TAB}"    iShell.SendKeys "{CTRL + V}"' ** Activate a program already open (by PID)    iShell.SendKeys "{TAB} {TAB} {TAB} {TAB}"    iShell.SendKeys "{CTRL + C}"' ** Activate a specify Internet Explorer 11 Window already open (by PID)    iShell.SendKeys "{TAB} {TAB} {TAB} {TAB}"    iShell.SendKeys "{CTRL + V}"    If msgbox("Repeat process?", vbYesNo) = vbYes Then       GoTo xRepeat    End if

I have some programs opened, and I dont want stay using "SendKeys {ALT + TAB}"

I work in a computer with extremely blocked access and basically my job is fill forms with the same answers all day, so I want fill automatically.

How so the computer that I use has no access to anything, I wish a solution that doesn't need to install anything.

I can use only notepad(.VBS or .BAT). Aah, I Can use VBA too, so the 'automation' above can be in .bat .vbs or in excell.vba as well. I know a lot of VBA, but only to do things into Excel

Ps: I can only get PID by notepad.bat "tasklist; @pause"

Thank you!

I was wondering if someone could help me? I have written the following code below, only to discover that in the sheet the row is copied successfully but not linked cells to the original row.

So when my team updates their pages and updates one of their rows with the condition Y, the row Moves over to the sheet collages with all Y rows ( flag list) ,however if they then update another cell in the row on their own page, say adapting the name or date this doesn’t reflect on the collated sheet.

I am very new to VBA but my team want this sorted ASAP, and I am really looking for someone to help me with this code.

Many thanks for any help with this, full code below:

Georgie

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)    If Target.Column = 12 Then        Set destinationSheet = ThisWorkbook.Sheets("FLAG LIST")        uniqueColumnlookup = 15        vNew = Target.Value        Application.EnableEvents = False        Application.Undo        vOld = Target.Value        Target.Value = vNew        Application.EnableEvents = True        If vNew <> vOld Then            lastrow =   C destinationSheet.Range("A"& Rows.Count).End(xlUp).Row            If vNew = "Y" Or vNew = "y" Then                lastrow = destinationSheet.Range("A"& Rows.Count).End(xlUp).Row                Sh.Cells(Target.Row, Target.Column).EntireRow.Copy Destination:=destinationSheet.Cells(lastrow + 1, 1)            End If            If vNew = "N" Or vNew = "n" Then                For i = 1 To lastrow                    If destinationSheet.Cells(i, uniqueColumnlookup).Value = Sh.Cells(Target.Row, uniqueColumnlookup).Value Then                        destinationSheet.Rows(i).EntireRow.Delete                    End If                Next            End If        End If    End IfEnd Sub

I'm writing a macro that will take a changing list of numbers (placed in an array), copy the equivalent slides from a powerpoint, and then paste the selected slides into another powerpoint (so if the numbers are 2, 5, and 7, the macro will copy/paste powerpoint slides 2, 5, and 7). I can make it work with individual array elements, but can't figure out how to pass all array elements at once into the selection. These are the relevant lines of code:

Dim NumberList() As VariantNumberList= Range("A11", Range("A10").End(xlDown))OriginalPowerpoint.Slides.Range(Array(NumberList(1, 1), NumberList(3, 1))).Copy'this is the line I'm having trouble withNewPowerpoint.Slides.Paste -1

The above code does work, but I want to pass the entire NumberList into Array() in the third line, as opposed to the current samples of NumberList(1,1) and NumberList(3,1). Just putting in "NumberList" or "NumberList()" doesn't work, and I'd really like to avoid making this a loop for efficiency reasons. Any advice would be greatly appreciated.

I am using VBA to insert a formula and fill it down an entire column. I am using absolute cell references.

FHWSCondensed.Cells(1, BBUUtilizationColumn).Value = "Number of BBUs with 3 nodes connected"Range(FHWSCondensed.Cells(2, BBUUtilizationColumn), FHWSCondensed.Cells(CondensedLimits(0), BBUUtilizationColumn)).Formula = "=COUNTIFS(C2,RC2,C4,3)"

That's the whole two lines of code, but the actual formula I'm inserting is just the thing at the end which is this:

.Formula = "=COUNTIFS(C2,RC2,C4,3)"

But when the VBA code runs, the formula that is inserted into the cell is:

Why is it doing this?

I’m trying to populate the yellow cells in my ‘All Completed Runs - J C’, ‘All Completed Runs - L C’, ‘All Completed Runs - TH C’ and ‘All Completed Runs - BR C’ worksheets.

What I need to display:In ‘All Completed Runs - J C’: all 7 events that have made up a run of 7 consecutive events which have been at 7 different countries.In ‘All Completed Runs - L C’: all 8 events that have made up a run of 8 consecutive events which have been at 8 different countries.In ‘All Completed Runs - TH C’: all 12 events that have made up a run of 12 consecutive events which have been at 12 different countries.In ‘All Completed Runs - BR C’: all 15 events that have made up a run of 15 consecutive events which have been at 15 different countries.I am already doing a similar kind of thing in the ‘Consecutive Countries example’ worksheet, but this looks for the longest run of consecutive events in all different countries, no matter how many. So, if you have done 2, it will list 2, 3 it will list 3 and so on. Here, I want it to only list all events in the longest run, if they meet the amount required for each worksheet. Otherwise, I want it to show the latest unended run, which could be just the last event completed (if it is the latest start of a new run).

The case here, then, is that ‘All Completed Runs - J C’ and ‘All Completed Runs - L C’, should both be fully completed (7 & 8 country runs), as my longest run is 9 consecutive different countries (August - September, 2019). This started with ‘Ross-on-Wye parkrun’ and ended with ’parkrun Kolomenskoe’. A United Kingdom parkrun was then again completed and ended the run. Whereas ‘All Completed Runs - TH C’ and ‘All Completed Runs - BR C’ should just show my latest unended run - my latest 3 runs in this case. As I haven’t yet made a run of 12, which is what would be required for ‘All Completed Runs - TH C’ or 15 for the ‘All Completed Runs - TH C’ worksheet to be completed.

Hope this makes sense. I have manually entered what should be displayed in the yellow cells.

I have attached a link to my file, here: https://drive.google.com/open?id=1x5F40hZ94fq81eEFTj9ADynVo_SXck4I

Thanks in advance!

I have some confusion about excel vba. My aim is to determine which shipments are exceed of the daily carton pick capacity or pallet pick capacity. Each month has different carton and pallet amount.

 For Each cell In Range("AB2:AB10000")   For i = 2 To 10000     If Mid(cell.Value, 4, 2) = "01" Then        toplam_karton_ocak = toplam_karton_ocak - Cells(i, 20)        toplam_palet_ocak = toplam_palet_ocak - cell(i, 19)        If toplam_palet_ocak < 0 Or toplam_karton_ocak < 0 Then            MsgBox (Cells(i, 1).Value & " nolu shipment kapasiteyi aşmaktadır.")        End If

I used "for each " to check every cell in the column and I used 12 "if" conditions to assign date to the right capacity. I tried to decrease the capacity when every shipment came. My aim is that if pallet or carton pick is less than zero, giving a message on the screen.

Mid(cell.Value, 4, 2) --> It takes 4th and 5th digits of the day. i.e the date is "22.05.2020".It receives "05" and that means "may"My problem is I could not do this for every day. I just did it for month but it is useless because i have to check it separately for every single day. What should i do?

You can find the full code below:

Sub New_DC()New_DC MakroRange("Z1").SelectActiveCell.FormulaR1C1 = "BOOKING ONLY DATES"Range("Z2").SelectActiveCell.FormulaR1C1 = "=LEFT([@[BOOKING_DATE_OR]],8)"Range("AA1").SelectActiveCell.FormulaR1C1 = "Column1 "Range("AA2").SelectActiveCell.FormulaR1C1 = _"=DATE(RIGHT([@[BOOKING ONLY DATES]],4),MID([@[BOOKING ONLY DATES]],3,2),LEFT([@[BOOKING ONLY DATES]],2))"Range("AB1").SelectActiveCell.FormulaR1C1 = "New DC"Range("AB2").SelectActiveCell.FormulaR1C1 = _"=IF(RC[-14]=""1-YES"",IF(ISBLANK([@[Sum of Carrier Lead Time]]),[@[Column1 ]]-[@[Sum of TRANSPORT_DURATION]],[@[Column1 ]]-[@[Sum of Carrier Lead Time]]),IF(ISBLANK([@[Sum of Carrier Lead Time]]),[@[END_TIME_UTC]]-[@[Sum of TRANSPORT_DURATION]],[@[END_TIME_UTC]]-[@[Sum of Carrier Lead Time]]))"Columns("AB:AB").SelectSelection.NumberFormat = "m/d/yyyy"Columns("Z:AA").SelectSelection.EntireColumn.Hidden = TrueRange("AE11").Select Range("Table1[[#Headers],[New DC]]").SelectActiveWorkbook.Worksheets("Data").ListObjects("Table1").Sort.SortFields.ClearActiveWorkbook.Worksheets("Data").ListObjects("Table1").Sort.SortFields.Add2 _    Key:=Range("Table1[[#Headers],[New DC]]"), SortOn:=xlSortOnValues, Order _    :=xlAscending, DataOption:=xlSortNormalWith ActiveWorkbook.Worksheets("Data").ListObjects("Table1").Sort    .Header = xlYes    .MatchCase = False    .Orientation = xlTopToBottom    .SortMethod = xlPinYin    .ApplyEnd WithRange("AC2").SelectActiveCell.FormulaR1C1 = _"=IF([@[Booking_Appointment_Made (groups)]]=""1-YES"",1,0)"Range("AC2").SelectRange(Selection, Selection.End(xlDown)).SelectActiveWorkbook.Worksheets("Data").ListObjects("Table1").Sort.SortFields.ClearActiveWorkbook.Worksheets("Data").ListObjects("Table1").Sort.SortFields.Add2 _    Key:=Range("AC2"), SortOn:=xlSortOnValues, Order:=xlDescending, _    DataOption:=xlSortNormalWith ActiveWorkbook.Worksheets("Data").ListObjects("Table1").Sort    .Header = xlYes    .MatchCase = False    .Orientation = xlTopToBottom    .SortMethod = xlPinYin    .ApplyEnd WithColumns("AC:AC").SelectSelection.EntireColumn.Hidden = True    Range("AB2").SelectDim toplam_karton_ocak As Long, toplam_karton_subat As Long, toplam_karton_mart As Long, toplam_karton_nisan As LongDim toplam_karton_mayis As Long, toplam_karton_haziran As Long, toplam_karton_temmuz As Long, toplam_karton_agustos As LongDim toplam_karton_eylul As Long, toplam_karton_ekim As Long, toplam_karton_kasim As Long, toplam_karton_aralik As LongDim toplam_palet_ocak As Integer, toplam_palet_subat As Integer, toplam_palet_mart As Integer, toplam_palet_nisan As IntegerDim toplam_palet_mayis As Integer, toplam_palet_haziran As Integer, toplam_palet_temmuz As Integer, toplam_palet_agustos As IntegerDim toplam_palet_eylul As Integer, toplam_palet_ekim As Integer, toplam_palet_kasim As Integer, toplam_palet_aralik As Integertoplam_karton_ocak = 15000toplam_palet_ocak = 300toplam_karton_subat = 15000toplam_palet_subat = 300toplam_karton_mart = 15000toplam_palet_mart = 300toplam_karton_nisan = 17000toplam_palet_nisan = 400toplam_karton_mayis = 17500toplam_palet_mayis = 600toplam_karton_haziran = 18000toplam_palet_haziran = 300toplam_karton_temmuz = 20000toplam_palet_temmuz = 300toplam_karton_agustos = 25000toplam_palet_agustos = 500toplam_karton_eylul = 42000toplam_palet_eylul = 900toplam_karton_ekim = 35000toplam_palet_ekim = 750toplam_karton_kasim = 27000toplam_palet_kasim = 750toplam_karton_aralik = 22500toplam_palet_aralik = 750For Each cell In Range("AB2:AB10000")For i = 2 To 10000     If Mid(cell.Value, 4, 2) = "01" Then        toplam_karton_ocak = toplam_karton_ocak - Cells(i, 20)        toplam_palet_ocak = toplam_palet_ocak - cell(i, 19)        If toplam_palet_ocak < 0 Or toplam_karton_ocak < 0 Then            MsgBox (Cells(i, 1).Value & " nolu shipment kapasiteyi aşmaktadır.")        End If     ElseIf Mid(cell.Value, 4, 2) = "02" Then        toplam_karton_subat = toplam_karton_subat - Cells(i, 20)        toplam_palet_subat = toplam_palet_subat - Cells(i, 19)        If toplam_palet_subat < 0 Or toplam_karton_subat < 0 Then            MsgBox (Cells(i, 1).Value & " nolu shipment kapasiteyi aşmaktadır.")        End If     ElseIf Mid(cell.Value, 4, 2) = "03" Then        toplam_karton_mart = toplam_karton_mart - Cells(i, 20)        toplam_palet_mart = toplam_palet_mart - Cells(i, 19)        If toplam_palet_mart < 0 Or toplam_karton_mart < 0 Then            MsgBox (Cells(i, 1).Value & " nolu shipment kapasiteyi aşmaktadır.")        End If     ElseIf Mid(cell.Value, 4, 2) = "04" Then        toplam_karton_nisan = toplam_karton_nisan - Cells(i, 20)        toplam_palet_nisan = toplam_palet_nisan - Cells(i, 19)        If toplam_palet_nisan < 0 Or toplam_karton_nisan < 0 Then            MsgBox (Cells(i, 1).Value & " nolu shipment kapasiteyi aşmaktadır.")        End If     ElseIf Mid(cell.Value, 4, 2) = "05" Then        toplam_karton_mayis = toplam_karton_mayis - Cells(i, 20)        toplam_palet_mayis = toplam_palet_mayis - Cells(i, 19)        If toplam_palet_mayis < 0 Or toplam_karton_mayis < 0 Then            MsgBox (Cells(i, 1).Value & " nolu shipment kapasiteyi aşmaktadır.")        End If     ElseIf Mid(cell.Value, 4, 2) = "06" Then        toplam_karton_haziran = toplam_karton_haziran - Cells(i, 20)        toplam_palet_haziran = toplam_palet_haziran - Cells(i, 19)        If toplam_palet_haziran < 0 Or toplam_karton_haziran < 0 Then            MsgBox (Cells(i, 1).Value & " nolu shipment kapasiteyi aşmaktadır.")        End If     ElseIf Mid(cell.Value, 4, 2) = "07" Then        toplam_karton_temmuz = toplam_karton_temmuz - Cells(i, 20)        toplam_palet_temmuz = toplam_palet_temmuz - Cells(i, 19)        If toplam_palet_temmuz < 0 Or toplam_karton_temmuz < 0 Then            MsgBox (Cells(i, 1).Value & " nolu shipment kapasiteyi aşmaktadır.")        End If     ElseIf Mid(cell.Value, 4, 2) = "08" Then        toplam_karton_agustos = toplam_karton_agustos - Cells(i, 20)        toplam_palet_agustos = toplam_palet_agustos - Cells(i, 19)        If toplam_palet_agustos < 0 Or toplam_karton_agustos < 0 Then            MsgBox (Cells(i, 1).Value & " nolu shipment kapasiteyi aşmaktadır.")        End If     ElseIf Mid(cell.Value, 4, 2) = "09" Then        toplam_karton_eylul = toplam_karton_eylul - Cells(i, 20)        toplam_palet_eylul = toplam_palet_eylul - Cells(i, 19)        If toplam_palet_eylul < 0 Or toplam_karton_eylul < 0 Then            MsgBox (Cells(i, 1).Value & " nolu shipment kapasiteyi aşmaktadır.")        End If     ElseIf Mid(cell.Value, 4, 2) = "10" Then        toplam_karton_ekim = toplam_karton_ekim - Cells(i, 20)        toplam_palet_ekim = toplam_palet_ekim - Cells(i, 19)        If toplam_palet_ekim < 0 Or toplam_karton_ekim < 0 Then            MsgBox (Cells(i, 1).Value & " nolu shipment kapasiteyi aşmaktadır.")        End If     ElseIf Mid(cell.Value, 4, 2) = "11" Then        toplam_karton_kasim = toplam_karton_kasim - Cells(i, 20)        toplam_palet_kasim = toplam_palet_kasim - Cells(i, 19)        If toplam_palet_kasim < 0 Or toplam_karton_kasim < 0 Then           MsgBox (Cells(i, 1).Value & " nolu shipment kapasiteyi aşmaktadır.")        End If     ElseIf Mid(cell.Value, 4, 2) = "12" Then        toplam_karton_aralik = toplam_karton_aralik - Cells(i, 20)        toplam_palet_aralik = toplam_palet_aralik - Cells(i, 19)        If toplam_palet_aralik < 0 Or toplam_karton_aralik < 0 Then           MsgBox (Cells(i, 1).Value & " nolu shipment kapasiteyi aşmaktadır.")        End If     End IfNext iNext cellColumns("AB:AB").SelectRange("AF6").SelectEnd Sub

Thanks for your help :)

please help. I am trying to create a user form in vba and I am checking the user inputs in the userform for duplicates in my database. I can get the userform to check for duplicates up to 4 criterions as shown below but once I include the check with the combobox MealPlan then it cannot see any duplicates anymore. Here is my code below:

Dim SprdSheet As WorksheetSet SprdSheet = ThisWorkbook.Sheets("LNR Rates")If Application.WorksheetFunction.CountIf(SprdSheet.Range("D:D"), Me.Inncode_B.Value) > 0 And _    Application.WorksheetFunction.CountIf(SprdSheet.Range("F:F"), Me.CompanyName_B.Value) > 0 And _    Application.WorksheetFunction.CountIf(SprdSheet.Range("G:G"), Me.DNumber_B.Value) > 0 And _    Application.WorksheetFunction.CountIf(SprdSheet.Range("H:H"), Me.Rate_B.Value) > 0 And _    Application.WorksheetFunction.CountIf(SprdSheet.Range("I:I"), Me.MealPlan_CB.Value) > 0 then     MsgBox "This is a duplicate"    Exit SubEnd If

I have an excel document with many columns and many rows filled with data.I want to be prevent user for sorting the data completely, but user should be able to insert and delete row as they wish. They can also edit any cells that they want.

May I know if there is anyway to achieve that?

Thanks.

I teach at a school. When I send an assignment, I create an individualized file that I want each student to work on.

I generate the individualized files using VBA and Excel.

I put Outlook in "Work Offline" mode so I can make sure the e-mails have the correct attachments and are OK before I put Outlook back online. I usually then hit the "send/receive all folders" button so they'll go out immediately while I'm watching.

This works great at work. I have Outlook configured with JUST my work e-mail.

I'm working from home, though, because of coronavirus and also because it's Summer.

On my Outlook at home (I'm using the installed app on a Windows 10 machine), I have 2 accounts configured.

Account #1 is a personal e-mail from a personal domain.

Account #2 is my e-mail account for work.

What I WANT is to generate e-mails like I do at work, and for them to go in the outbucket of my work account. I would then send them from there.

However, no matter what I do, they go into the outbucket of my personal account. I don't want students to get an e-mail from an unrecognized sender. Nor do I want them replying to those e-mails with their questions.

Here is the code I run to create the e-mails:

Sub makemail()    Dim strLocation As String    Dim OutApp As Object    Dim OutMail As Object    Dim OutAccount As Object    Range("a1").Activate    eaddy = ActiveCell.Offset(0, 4).Value 'student's e-mail address in a worksheet    IndivFile = ActiveCell.Offset(0, 8).Value 'this is an identifier for the student's individual file    LastName = ActiveCell.Offset(0, 1).Value ' student's last name    Do Until ActiveCell.Value = ""        Set OutApp = CreateObject("Outlook.Application")        Set OutMail = OutApp.CreateItem(0)        Set OutAccount = OutApp.Session.Accounts.Item(1)        On Error Resume Next        With OutMail            .To = eaddy            .CC = ""            .BCC = ""            .Subject = LastName & " (text that describes the assignment)"            .Body = "(body of message)"            strLocation = "(location of the individual attachments"& IndivFile & ".xlsx"            .Attachments.Add (strLocation)            .Send        End With        On Error GoTo 0        Set OutMail = Nothing        Set OutApp = Nothing        Set OutAccount = Nothing        With Application            .ScreenUpdating = True            .EnableEvents = True        End With        ActiveCell.Offset(1, 0).Activate        eaddy = ActiveCell.Offset(0, 4).Value        IndivFile = ActiveCell.Offset(0, 8).Value        LastName = ActiveCell.Offset(0, 1).Value    LoopEnd Sub

No matter what I do, it will ONLY dump the generated e-mails into the outbucket of account #1 in outlook: my personal account.

I have tried replacing

.Send

with

.SendUsingAccount = OutApp.Session.Accounts.Item(2)

Putting anything in the parens (including a 0 or 1) will mean I don't see the output in either outbucket. (No idea if the e-mails even generated. they're probably sitting in some directory I haven't looked in.)

So, I just generated all the e-mails and they showed up in my personal account's outbucket.

I selected them all and dropped them into the outbucket of my work account.

They would not send. I clicked the "send/receive" and they won't go anywhere.

HOWEVER, if I open up each e-mail individually and click the "send" button in the e-mail? They go. I see them in my sent folder.

I don't know that much about Outlook. Just that it worked for this until now. I wonder if maybe this is some sort of mismatched certificate problem on the e-mails? But if that were the case, why don't they go in bulk, but will go if sent indivually with the e-mail open?

(I just tested. if the e-mails are marked read or unread, it makes no difference.)

I did set my work-email as the primary in Outlook (File > Account Settings > Designate one account as the primary one.

So, here are my basic questions:

1. Is there a way, code-wise, to put this in the 2nd account's outbucket (work)? Keep in mind that

.SendUsingAccount = OutApp.Session.Accounts.Item(2)

does not work. At all.

2. If I can't do that, is there a way to change my e-mail accounts so the work one is #1? Other than deleting and re-installing in a specific order? I DID go in and make the work-email my primary e-mail.

3. Does anybody know why they won't send in one outbucket (because they were dragged and dropped from another outbucket), but will send if you open them individually and send them?

I am trying to do a "for each" sub in VBA, comparing two pairs of rows and the values in each cell to one another. For example row 2 is compared with row 3, row 4 is compared with row 5 etc. I need the code to highlight the differences in each cell for each of the comparisons. This is what I have so far and I cannot seem to get it to work. Any thought?

Sub testing_2()Dim rw_2 As Range, rw_1 As Range, decisions As Stringdecisions = MsgBox("Check accuracy?", vbYesNo)If decisions = vbYes Then    For Each rw_1 In Worksheets("worksheet").Rows        For Each rw_2 In Worksheets("worksheet").Rows            If Not StrComp(rw_1.row Mod 2 = 0, rw_2.row Mod 2 = 1, vbBinaryCompare) = 0 Then                Range(rw_1.row Mod 2 = 0, rw_2.row Mod 2 = 1).Interior.ColorIndex = 6            End If        Next rw_2    Next rw_1Else: End IfEnd Sub

Thank you!

Basically, I am looking at each row, two at a time, and highlighting the different values between them.

I want to iterate over all sheets on another workbook and change the every sheets name based on the cell value. my code for looping can visit every sheet if i only msgbox the name of the sheet but if i rename it - only the first sheet can be renamed and the others will not, second loop is not going though.[enter image description here][1]

Dim i As Integer, ws_count As Integer, callNewWB As WorkbookSet callNewWB = [new workbook to rename the sheets]ws_count = callNewWB.Sheets.CountFor i = 1 To ws_count    callNewWB.Sheets(i).Select    callNewWB.Sheets(i).Name = ThisWorkbook.Sheets("Masterlist").Cells(i + 3, 2)Next i