I have made two functions that makes a calculation from two different linest (UpperCalc and LowerCalc). This works fine.
Then I will need to fill in formulas for an unknown number of cells (depending on the input on another sheet). I have been able to fill in formulas for the correct number of cells. But when I try to include an "IF"-formula in the VBA programming together with the function names, it does not work? My VBA code to fill in the formula looks like this now;
Dim lastRow As Long, i As Long, ws1 As Worksheet, ws2 As Worksheet
Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("Sheet2")
lastRow = ws1.Range("B" & Rows.Count).End(xlUp).Row
With ws1
For i = 2 To lastRow
If Len(Trim(.Range("A" & i).Value)) <> 0 Then _
ws2.Range("A" & i).Value = ws1.Range("A" & i).Value
ws2.Range("B" & i).Value = ws1.Range("B" & i).Value
ws2.Range("C" & i).Formula = "=IF(RC[-1]>R4C12,UpperCalc(RC[-1]),LowerCalc(RC[-1]))"
Next i
End With
End If
I am able to insert formula with one of these functions (for instance ws2.Range("C" & i).Formula = "=UpperCalc(RC[-1])", and also only with an "IF" formula (for instance ws2.Range("C" & i).Formula = "=IF(RC[-1]>R4C12,RC[-1],RC[-1]^2)" - This is of course not the actual calculation needed - only to test the "IF"-function).
Since the calculation behind UpperCalc and LowerCalc is rather "dirty", I would like to utilize the functions. Any ideas?
Related
I am trying to create a macro.
LR = Range("Y3333333").End(x1Up).Row
Range("C3").AutoFill Destination:=Range("Y3:Y" & LR)
LR = Range("C3333333").End(x1Up).Row
Range("C3").AutoFill Destination:=Range("R3:R" & LR)
LR = Range("C3333333").End(x1Up).Row
Range("C3").AutoFill Destination:=Range("B3:B" & LR)
LR = Range("C3333333").End(x1Up).Row
Range("C3").AutoFill Destination:=Range("A3:A" & LR)
My number of rows varies each time I run this. These (4) columns have nothing in rows 1 or 2. Row three is a formula that I want to copy to the last column.
Column C is the only column that will always have information in it all all times for all lines.
use:
Dim LR As Long
With Worksheets("Sheet1") 'Change to your Worksheet name
LR = .Cells(.Rows.Count, 3).End(xlUp).row
.Range("Y3:Y" & LR).FillDown
.Range("R3:R" & LR).FillDown
.Range("B3:B" & LR).FillDown
.Range("A3:A" & LR).FillDown
End With
An alternative (more common) way of writing it is:
Dim LR As Long
LR = Activesheet.Range("Y" & Rows.Count).End(xlUp).Row
Range("C3").AutoFill Destination:=Range("Y3:Y" & LR)
This would work in any sheet (also compatibility mode), and you do not need to autofill anymore
I am trying to have vba create a formula for two ranges within the same data set, as input into variables lastRow and lastRow2. However, when I try to create and calculate the formula, instead of getting the value of the last cell I get a zero. Offending code below:
Dim lastRow As Long
Dim lastRow2 As Long
lastRow = Range("A" & Rows.Count).End(xlUp).Row
lastRow2 = Range("M" & Rows.Count).End(xlUp).Row
...
'Calculate ATRT 2014 at cell B4
Range("B6").Formula = "=(SUM(J11:J" & lastRow & ")/ SUM(I11:I" & lastRow & "))"
Range("E6").Formula = "=(SUM(U11:U" & lastRow2 & ")/ SUM(T11:T" & lastRow2 & "))"
Range("H6").Formula = "=E6-B6"
Running this gets two formulas: =(SUM(J11:J0)/ sum(I11:I0)) and =(SUM(U11:U0)/ SUM(T11:T0)). Why is the end of the range a zero???
I'm pretty sure what is happening if you are not defining which worksheet the range() and row() objects are on so VBA is guessing and probably guessing incorrectly. Try adding a worksheet object and then defining all the ranges and rows to use be on that worksheet.
Dim lastRow As Long
Dim lastRow2 As Long
Dim ws As Worksheet
Set ws = ActiveSheet
lastRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
lastRow2 = ws.Range("M" & ws.Rows.Count).End(xlUp).Row
'...
'Calculate ATRT 2014 at cell B4
ws.Range("B6").Formula = "=(SUM(J11:J" & lastRow & ")/ SUM(I11:I" & lastRow & "))"
ws.Range("E6").Formula = "=(SUM(U11:U" & lastRow2 & ")/ SUM(T11:T" & lastRow2 & "))"
ws.Range("H6").Formula = "=E6-B6"
I am trying to copy and paste data from an input sheet into an output sheet, and once the data is in the next spreadsheet, it will be filled down the next rows from a starting date to an ending date.
As is, the code gets me the following errors when debugging:
ws1.Range("A" & NextRow) = Method of Range Object_Worsheet failed; same for ws1.Range("B" & NextRow); ws1.Range("C" & NextRow) etc...
ws1.Cells(LastRow, "H") = Application-defined or object-defined error.
Also, I noticed that when I set RawDataEntries it equals 37, that is the last non-empty row, but then when I try to use the For loop and point my mouse on RawDataEntries in For n=1 To RawDataEntries, VBA returns me a value of 105, which seems to come out of nowhere.
I think the logic behind the code is correct. What might have gone wrong?
Sub AddFlight_Click()
Const RNG_END_DT As String = "N2"
Dim NextRow1 As Long, LastRow1 As Long, ws1 As Worksheet
Dim ws2 As Worksheet, RawDataEntries As Long
Set ws1 = Sheets("JetAir Flight Plan")
Set ws2 = Sheets("TUI B Flight Plan")
LastRow1 = ws1.Range("A" & Rows.Count).End(xlUp).Row
NextRow1 = LastRow1 + 1
RawDataEntries = ws2.Range("A" & Rows.Count).End(xlUp).Row
For n = 1 To RawDataEntries
'Data from an input worksheet is copied and pasted into specific cells in an output worksheet.
ws1.Range("A" & NextRow).Value = ws2.Range("A" & n).Value
ws1.Range("B" & NextRow).Value = ws2.Range("B" & n).Text
ws1.Range("D" & NextRow).Value = ws2.Range("D" & n).Text
ws1.Range("E" & NextRow).Value = ws2.Range("E" & n).Text
ws1.Range("F" & NextRow).Value = ws2.Range("F" & n).Text
ws1.Range("G" & NextRow).Value = ws2.Range("G" & n).Text
ws1.Range(RNG_END_DT).Value = ws2.Range("H" & n).Value
'A series of dates is created from a starting date
' to an ending date in column A of ws1.
ws1.Range("A" & NextRow).DataSeries Rowcol:=xlColumns, _
Type:=xlChronological, Date:=xlDay, Step:=7, _
Stop:=ws1.Range(RNG_END_DT).Value, Trend:=False
'The data filled in the last row with the userform data through
' the first part of the macro will be copied and pasted in
' the next row until there is a blank cell in column A.
LastRow1 = ws1.Range("A" & Rows.Count).End(xlUp).Row
ws1.Range(ws1.Range("B" & NextRow), ws1.Cells(LastRow, "H")).FillDown
'We repeat the process for other rows on the sheet data are pulled from
Next n
Thanks a lot.
Change NextRow to NextRow1. Right now you are calling a variable that doesn't exist.
Or you can do the opposite (NextRow1 to NextRow)
Same with LastRow and LastRow1
I have one document (two sheets) that I am trying to compare between. I have cleaned up the columns so both have our unique reference number in column A, the vendor expense in column B and the revenue in column C. I am trying to do an internal audit of sorts without going through every one individually.
One sheet contains data from two years whereas the other contains data from one year. It is not a definitive date so I didn't want to remove any.
Accountants Export
My Data
How would I go about matching the unique identifier in column A and highlighting if there is a difference in the information in column B or C?
here is the code to do it in VBA
I suppose for both Sheet1 and Sheet2 that:
ColumnA is "Pro", ColumnB Gross Rate and ColumnC "Carrier Exp"
All headers are in Row1 and the data starts in row2
Here is the code:
Sub test()
Dim wb As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
Dim Lastrow As Long, Lastrow2 As Long
Dim i As Integer, j As Integer
Set wb = ThisWorkbook
Set ws1 = wb.Sheets("Sheet1")
Set ws2 = wb.Sheets("Sheet2")
Lastrow = ws1.Range("A" & Rows.Count).End(xlUp).Row
Lastrow2 = ws2.Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To Lastrow
For j = 2 To Lastrow2
If ws1.Range("A" & i).Value = ws2.Range("A" & j).Value Then
If Not ws1.Range("B" & i).Value = ws2.Range("B" & j).Value Then
ws1.Range("B" & i).Interior.Color = vbYellow
ws2.Range("B" & j).Interior.Color = vbYellow
End If
If Not ws1.Range("C" & i).Value = ws2.Range("C" & j).Value Then
ws1.Range("C" & i).Interior.Color = vbYellow
ws2.Range("C" & j).Interior.Color = vbYellow
End If
End If
Next j
Next i
End Sub
I have a copy / paste loop for line items in an Excel file that exports data from these line items into an Excel-based form and saves each form by the value in Row B. My issue is that these line items are divided into 3 different tables on the same sheet, each with a different number of line items to be copied. Furthermore, each table is separated by 2 blank rows.
What I need the macro to do for me:
Start at line 17 and copy all line items in the first table until it hits a blank row - this varies from 1 to 600 rows.
Skip to SecondTable and perform the same functions.
Repeat for ThirdTable
Ignore some of the declarations as I deleted a large chunk of code for readability. I figured I would need 3 separate copy/paste loops to accomplish this (I've only included 2 here) and I tried using .Find to reference the start of the second/third tables. The macro runs as normal through the first table, but doesn't stop when it hits a blank row and fails when it tries to save a file based on the value of an empty cell. I believe the issue lies with the EndOne = .Range("B" & .Rows.Count).End(xlUp).Row argument right under With wsSource. Instead of counting only the non-blank rows of the first table, it counts the number of rows through the end of the third table.
Sub CopyToForm()
Dim wbSource As Workbook, wbForm As Workbook
Dim wsSource As Worksheet, wsForm As Worksheet
Dim formpath As String, foldertosavepath As String
Dim EndOne As Long, EndTwo As Long, EndThree As Long, i As Integer
Dim strProcessingFormPath As String
'Dim strCancel As String
'Dim strFilt As String
'Dim intFilterIndex As Integer
'Dim strDialogueFileTitle As String
Dim SecondTable As String
Dim ThirdTable As String
Set wbSource = ThisWorkbook '~~> Write your code in Indication Tool.xls
Set wsSource = wbSource.Sheets("Indication Tool") '~~> Put the source sheet name
With wsSource
'~~> Counts how many rows are in the Indication Tool
EndOne = .Range("B" & .Rows.Count).End(xlUp).Row
If EndOne < 17 Then MsgBox "No data for transfer": Exit Sub
For i = 17 To EndOne
Set wbForm = Workbooks.Open(formpath) '~~> open the form
Set wsForm = wbForm.Sheets("Processing Form") '~~> Declare which worksheet to activate
'~~> Proceed with the copying / pasting of values
.Range("B" & i).Copy wsForm.Range("F7:K7")
.Range("C" & i).Copy: wsForm.Range("D8").PasteSpecial xlPasteValues
.Range("C" & i).Copy: wsForm.Range("D30").PasteSpecial xlPasteValues
.Range("D" & i).Copy: wsForm.Range("H29").PasteSpecial xlPasteValues
.Range("E" & i).Copy: wsForm.Range("E29").PasteSpecial xlPasteValues
.Range("F" & i).Copy: wsForm.Range("D33").PasteSpecial xlPasteValues
.Range("G" & i).Copy: wsForm.Range("K30").PasteSpecial xlPasteValues
.Range("H" & i).Copy: wsForm.Range("P33").PasteSpecial xlPasteValues
.Range("L" & i).Copy: wsForm.Range("H32").PasteSpecial xlPasteValues
.Range("R" & i).Copy: wsForm.Range("D87").PasteSpecial xlPasteValues
'.Range("C5:M5").Copy: wsForm.Range("E102").PasteSpecial xlPasteValues
'~~> Save the form using the value in cell i,B
wbForm.SaveAs .Range("B" & i).Value & ".xls"
wbForm.Close
Set wbForm = Nothing
Set wsForm = Nothing
Next
End With
With wsSource
SecondTable = .Range("B:B").Find("SecondTable").Row
EndTwo = .Range("B" & .Rows.Count).End(xlUp).Row
For i = Second Table + 1 To EndTwo
Set wbForm = Workbooks.Open(formpath) '~~> open the form
Set wsForm = wbForm.Sheets("Processing Form") '~~> Declare which worksheet to activate
'~~> Proceed with the copying / pasting of values
.Range("B" & i).Copy wsForm.Range("F7:K7")
.Range("C" & i).Copy: wsForm.Range("D8").PasteSpecial xlPasteValues
.Range("C" & i).Copy: wsForm.Range("D30").PasteSpecial xlPasteValues
.Range("D" & i).Copy: wsForm.Range("H29").PasteSpecial xlPasteValues
.Range("E" & i).Copy: wsForm.Range("E29").PasteSpecial xlPasteValues
.Range("F" & i).Copy: wsForm.Range("D33").PasteSpecial xlPasteValues
.Range("G" & i).Copy: wsForm.Range("K30").PasteSpecial xlPasteValues
.Range("H" & i).Copy: wsForm.Range("P33").PasteSpecial xlPasteValues
.Range("L" & i).Copy: wsForm.Range("H32").PasteSpecial xlPasteValues
.Range("R" & i).Copy: wsForm.Range("D87").PasteSpecial xlPasteValues
.Range("C5:M5").Copy: wsForm.Range("E102").PasteSpecial xlPasteValues
'~~> Save the form using the cells i,B
wbForm.SaveAs .Range("B" & i).Value & ".xls"
wbForm.Close
Set wbForm = Nothing
Set wsForm = Nothing
Next
End With
End Sub
Am I on the right track with the .Find and a separate copy/paste loop for each table? I realize this is a complex problem and I appreciate any time you take to spend helping me out.
Am I on the right track with the .Find and a separate copy/paste loop for each table?
Not exactly. The code inside those loops is largely the same, so it is a good candidate for subroutine. This will make your code more human-readable, and also makes it easier to maintain since there will only be one place to make revisions, instead of multiple (imagine if you needed to do 10 different iterations, or 1,000 -- you wouldn't possibly write 1,000 different loops to do the same thing!!)
Consider this instead (I observe a few obvious errors which I will correct, but this is not tested). What I have done is to take your several loops, and consolidate them in to a single subroutine. Then we send some information like where the table starts and where it ends, to that subroutine:
Sub CopyStuff(ws as Worksheet, tblStart as Long, tblEnd as Long)
We will send it: wsSource, and the other variables will be used/re-used to determine the start/end of each table. I removed the redundant variables (unless they need to be re-used elsewhere, having two variables EndOne and EndTwo is unnecessary: we can make use of more generic variables like tblStart and tblEnd which we can reassign for subsequent tables.
In this way it is a lot more apparent that we are processing multiple tables in an identical manner. We also have only a single For i = ... loop to manage, should the code require changes in the future. So it is easier to comprehend, and easier to maintain.
Sub CopyToForm()
Dim wbSource As Workbook 'No longer needed in this context: wbForm As Workbook
Dim wsSource As Worksheet 'No longer needed in this context: wsForm As Worksheet
Dim formpath As String, foldertosavepath As String
Dim tblEnd As Long, tblStart As Long, i As Integer
Dim strProcessingFormPath As String
Dim tblStart as Integer: tblStart = 16
Set wbSource = ThisWorkbook '~~> Write your code in Indication Tool.xls
Set wsSource = wbSource.Sheets("Indication Tool") '~~> Put the source sheet name
With wsSource
'~~> Counts how many rows are in the Indication Tool
tblEnd = .Range("B" & .Rows.Count).End(xlUp).Row
If tblEnd < 17 Then GoTo EarlyExit '## I like to use only one exit point from my subroutines/functions
CopyStuff wsSource, tblStart, tblEnd
tblStart = .Range("B:B").Find("SecondTable").Row + 1
tblEnd = .Range("B" & .Rows.Count).End(xlUp).Row
CopyStuff wsSource, tblStart, tblEnd
'And presumably...
tblStart = .Range("B:B").Find("ThirdTable").Row + 1
tblEnd = .Range("B" & .Rows.Count).End(xlUp).Row
CopyStuff wsSource, tblStart, tblEnd
End With
Exit Sub
EarlyExit:
MsgBox "No data for transfer"
End Sub
Private Sub CopyStuff(ws As Worksheet, tblStart as Long, tblEnd as Long)
Dim wbForm as Workbook, wsForm as Worksheet, i As Long
With ws
For i = tblStart to tblEnd
Set wbForm = Workbooks.Open(formpath) '~~> open the form
Set wsForm = wbForm.Sheets("Processing Form") '~~> Declare which worksheet to activate
'~~> Proceed with the copying / pasting of values
.Range("B" & i).Copy wsForm.Range("F7:K7")
.Range("C" & i).Copy: wsForm.Range("D8").PasteSpecial xlPasteValues
.Range("C" & i).Copy: wsForm.Range("D30").PasteSpecial xlPasteValues
.Range("D" & i).Copy: wsForm.Range("H29").PasteSpecial xlPasteValues
.Range("E" & i).Copy: wsForm.Range("E29").PasteSpecial xlPasteValues
.Range("F" & i).Copy: wsForm.Range("D33").PasteSpecial xlPasteValues
.Range("G" & i).Copy: wsForm.Range("K30").PasteSpecial xlPasteValues
.Range("H" & i).Copy: wsForm.Range("P33").PasteSpecial xlPasteValues
.Range("L" & i).Copy: wsForm.Range("H32").PasteSpecial xlPasteValues
.Range("R" & i).Copy: wsForm.Range("D87").PasteSpecial xlPasteValues
'.Range("C5:M5").Copy: wsForm.Range("E102").PasteSpecial xlPasteValues
'~~> Save the form using the value in cell i,B
wbForm.SaveAs .Range("B" & i).Value & ".xls"
wbForm.Close
Set wbForm = Nothing
Set wsForm = Nothing
Next
End With
End Sub