using a variable name in my VBA sumif formula - vba

I have built a code that performs a sumif on another workbook that I open using the get open filename dialogue box. I intend to use this formula daily, and hence the workbook where I intend to obtain the information and the workbook where I intend to paste the results will continue to have varying names basing on the date of the day.
I get a type mismatch on the SUMIF formula. Please help.
Sub flextab()
Dim LastCol As Integer, LastRow As Long
' Get the dimensions
With Sheets("Flex")
LastCol = .Cells(2, .Columns.Count).End(xlToLeft).Column
End With
'Insert a column where required.
Cells(2, LastCol - 1).EntireColumn.Insert
'Insert the date
Cells(2, LastCol - 1).Value = Date - 1
'Insert the balance sheet balances for the day
Dim wb1 As Workbook, wb2 As Workbook
Dim FileName1 As String, FileName2 As String
Dim BalSheet As Worksheet
Dim Ret1
FileName1 = ThisWorkbook.Name
'~~> Get the first File
Ret1 = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", _
, "Please select the Balance sheet for the day")
If Ret1 = False Then Exit Sub
Set wb2 = Workbooks.Open(Ret1)
FileName2 = wb2.Name
Workbooks(FileName1).Activate
'let's get a reference to the worksheet with the source values
Set BalSheet = Workbooks(FileName2).Worksheets("Sheet1")
With Worksheets("Flex").Range(Cells(5, LastCol - 1), Cells(109, LastCol - 1))
'let's put in our SUMIF formulas
.Formula = "=SUMIF(" & BalSheet.Range("B2:B20000") & "," & Worksheets("Flex").Range("A5") & " , " & BalSheet.Range("n2:n20000") & ")"
'let's convert the formulas into values
.Value = .Value
End With
wb2.Close SaveChanges:=False
Set wb2 = Nothing
Set wb1 = Nothing
End Sub

You are adding ranges to a string, while ranges are objects. Try this:
"=SUMIF(" & BalSheet.Range("B2:B20000").Address & "," & Worksheets("Flex").Range("A5").Value & " , " & BalSheet.Range("n2:n20000").Address & ")"
instead of this:
"=SUMIF(" & BalSheet.Range("B2:B20000") & "," & worksheets("Flex").Range("A5") & " , " & BalSheet.Range("n2:n20000") & ")"
You are working with 2 workbooks, but you are using some worksheets without qualifier.
If you have focus to the wrong workbook this will fail if the workbook that is active does not have a Flex worksheet.
So change this:
Worksheets("Flex").Range(Cells(5, LastCol - 1)
to this:
wbX.Worksheets("Flex").Range(Cells(5, LastCol - 1)
where the X is the correct workbook.

Related

Consolidate data in Excel with VBA

At some point I need to consolidate data (simply sum duplicated items). I would like to parameterize Sources:= argument - actually everything works the way I amused when using option after single quote mark. When using src variable I'm getting: Cannot open consolidation source file (picture attached). Looking forward for some tips.
Here is the code:
Sub Format()
' Keyboard Shortcut: Ctrl+Shift+C
'Definition
Dim wb As Workbook
Dim ws As Worksheet
Dim rg As Range
Dim lRow As Integer
Dim src As String
Set wb = ActiveWorkbook
Set ws = ThisWorkbook.ActiveSheet
'Format data
Range("H2").Select
ActiveCell.FormulaR1C1 = "=RC[-5]&""*""&RC[-4]&""*""&RC[-3]&""*""&RC[-2]"
Range("I2").Select
ActiveCell.FormulaR1C1 = "=RC[-7]"
' Find the last non-blank cell in column B(2)
lRow = Cells(Rows.Count, 2).End(xlUp).Row
Set rg = Range("H2", Cells(lRow, 9))
' AutoFill of formated data
Range("H2:I2").Select
Selection.AutoFill Destination:=rg, Type:=xlFillDefault
'Consolidate
src = """" & "'" & wb.Path & "\[" & wb.Name & "]" & ws.Name & "'!R2C8:R" & lRow & "C9" & """"
Debug.Print src
'Range("K2").Consolidate Sources:= _
"'C:\Users\pl1aji0\Documents\Projekty\USA\2020\L034.00080 Innovation\700\BPM\[test.xlsx]Sheet1'!R2C8:R11C9" _
, Function:=xlSum, TopRow:=False, LeftColumn:=True, CreateLinks:=False
Range("K2").Consolidate Sources:= _
src _
, Function:=xlSum, TopRow:=False, LeftColumn:=True, CreateLinks:=False
End Sub

Posting a concatenated formula in VBA based on a newly created worksheet labeled as a date

I have a script which creates a copy of a worksheet with data on it, queries new data, and then uses a lookup (SUMIFS in this case) to pull any manual entries from the old sheet onto the new. I am getting an application-defined/object-defined error message on the line that drops the formula onto the page (the last line below). I attempted adding the formula directly instead, using .Cells, etc., but it must be in the language of the formula itself because I can drop a direct formula in this way (e.g. .Range("N2:N" & LastRow) = "=M2*H2")
Dim CopySheet As String
Dim QSheet As String
Dim FormulaS As String
Dim LastRow As Integer
Dim CoreWB As Workbook
Set CoreWB = ActiveWorkbook
QSheet = "QData"
CopySheet = Format(Date, "mm-dd-yy")
With CoreWB
.Sheets.Add(After:=.Sheets("HistSum")).Name = CopySheet
.Sheets(QSheet).Cells.Copy _
Destination:=Sheets(CopySheet).Cells
End With
FormulaS = "=SUMIFS(" + CopySheet + "!M:M," + CopySheet + "!A:A, A:A," + CopySheet + "!C:C, C:C," + CopySheet + "!J:J, J:J," + CopySheet + ",!E:E, E:E)"
With Sheets(QSheet)
LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("M2:M" & LastRow).Formula = FormulaS
Try
LastRow should be > 1
Use Long rather than Integer
There was a typo "," at the end
Add ' before and after sheet name
Concatenate with & (as per comments)
Use Worksheets collection
I think you can just post to destination Worksheets(CopySheet).Range("A1") - but I could be wrong.
Code:
Option Explicit
Sub TEST()
Dim CopySheet As String
Dim QSheet As String
Dim FormulaS As String
Dim LastRow As Long
Dim CoreWB As Workbook
Set CoreWB = ActiveWorkbook
QSheet = "QData"
CopySheet = Format$(Date, "mm-dd-yy")
With CoreWB
.Sheets.Add(After:=.Worksheets("HistSum")).Name = CopySheet
.Sheets(QSheet).Cells.Copy _
Destination:=Worksheets(CopySheet).Cells
End With
FormulaS = "=SUMIFS(" & "'" & CopySheet & "'!M:M,'" & CopySheet & "'!A:A, A:A,'" & CopySheet & "'!C:C, C:C,'" & CopySheet & "'!J:J, J:J,'" & CopySheet & "'!E:E, E:E)"
With Worksheets(QSheet)
LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
' LastRow > 1
.Range("M2:M" & LastRow).Formula = FormulaS
End With
End Sub

VBA to VLOOKUP a value from a pivot table to return value in multiple columns in the output sheet

I have two sheets, one is sheet Data Sheet with a pivot table with data of different companies. I have another sheet Output Sheet with few column headings from data sheet, I want to vlookup different column headings using the Company ID. I have found the below code and it works fine for mapping company name but has the following issues
The formula runs till 100000 rows even if the companyID is available only till 9555 row, and there after displays #N/A
How to make this formula lookup other column headings like Segment, Sector Etc.
Columns Heading that needs to be mapped:
Sub MakeFormulas()
Dim SourceLastRow As Long
Dim OutputLastRow As Long
Dim sourceBook As Workbook
Dim sourceSheet As Worksheet
Dim outputSheet As Worksheet
Application.ScreenUpdating = True
'Where is the source workbook?
Set sourceBook = Workbooks.Open("C:\Users\AAA\Desktop\NewFolder\Automation\07-Macro.xlsb")
'what are the names of our worksheets?
Set sourceSheet = sourceBook.Worksheets("TERFYTDPR")
Set outputSheet = ThisWorkbook.Worksheets("All TMS-Data")
'Determine last row of source
With sourceSheet
SourceLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
With outputSheet
'Determine last row in col B
OutputLastRow = .Cells(.Rows.Count, "B").End(xlUp).Row + 1
'Apply our formula
.Range("B2:B10000" & OutputLastRow).Formula = _
"=VLOOKUP(A2,'[" & sourceBook.Name & "]" & sourceSheet.Name & "'!$A$2:$B$" & SourceLastRow & ",2,0)"
OutputLastRow = .Cells(.Rows.Count, "B").End(xlUp).Row + 1
End With
'Close the source workbook, don't save any changes
sourceBook.Close False
Application.ScreenUpdating = True
End Sub
We don't know the layout of your data on the Worksheet you are doing the Vlookup against, but just thought I would explain the Vlookup:
=VLOOKUP(A2,'[" & sourceBook.Name & "]" & sourceSheet.Name & "'!$A$2:$B$" & SourceLastRow & ",2,0)"
The last number 2 on the line of code above refers to the column number you would like to return if the Contents of A2 match, you can alter this to get another column number, such as 3 for the third column, but you should also change the range to lookup from $A$2:$B$, to include the other columns.
So for example if your Segment column is in Column C, you would alter your vlookup as such:
=VLOOKUP(A2,'[" & sourceBook.Name & "]" & sourceSheet.Name & "'!$A$2:$C$" & SourceLastRow & ",3,0)"
I would also re-write your code as follows:
Sub MakeFormulas()
Dim SourceLastRow As Long, OutputLastRow As Long, i As Long
Dim sourceBook As Workbook
Dim sourceSheet As Worksheet, outputSheet As Worksheet
Application.ScreenUpdating = True
'Where is the source workbook?
Set sourceBook = Workbooks.Open("C:\Users\AAA\Desktop\NewFolder\Automation\07-Macro.xlsb")
'what are the names of our worksheets?
Set sourceSheet = sourceBook.Worksheets("TERFYTDPR")
Set outputSheet = ThisWorkbook.Worksheets("All TMS-Data")
'Determine last row of source
SourceLastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "A").End(xlUp).Row
'Determine last row in col B
OutputLastRow = outputSheet.Cells(outputSheet.Rows.Count, "A").End(xlUp).Row
'Apply our formula
For i = 2 To OutputLastRow
outputSheet.Range("B" & i).Formula = "=VLOOKUP(A" & i & ",'[" & sourceBook.Name & "]" & sourceSheet.Name & "'!$A$2:$C$" & SourceLastRow & ",2,0)"
outputSheet.Range("C" & i).Formula = "=VLOOKUP(A" & i & ",'[" & sourceBook.Name & "]" & sourceSheet.Name & "'!$A$2:$C$" & SourceLastRow & ",3,0)"
'if segment is found in column C, and you also want the results in column C the line above will return the desired value
Next i
'Close the source workbook, don't save any changes
sourceBook.Close False
Application.ScreenUpdating = True
End Sub
UPDATE:
To do the same without a loop:
Sub MakeFormulas()
Dim SourceLastRow As Long, OutputLastRow As Long, i As Long
Dim sourceBook As Workbook
Dim sourceSheet As Worksheet, outputSheet As Worksheet
Application.ScreenUpdating = True
'Where is the source workbook?
Set sourceBook = Workbooks.Open("C:\Users\AAA\Desktop\NewFolder\Automation\07-Macro.xlsb")
'what are the names of our worksheets?
Set sourceSheet = sourceBook.Worksheets("TERFYTDPR")
Set outputSheet = ThisWorkbook.Worksheets("All TMS-Data")
'Determine last row of source
SourceLastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "A").End(xlUp).Row
'Determine last row in col B
OutputLastRow = outputSheet.Cells(outputSheet.Rows.Count, "A").End(xlUp).Row
'Apply our formula
outputSheet.Range("B2:B:" & OutputLastRow).Formula = "=VLOOKUP(A2,'[" & sourceBook.Name & "]" & sourceSheet.Name & "'!$A$2:$C$" & SourceLastRow & ",2,0)"
outputSheet.Range("C2:C" & OutputLastRow).Formula = "=VLOOKUP(A2,'[" & sourceBook.Name & "]" & sourceSheet.Name & "'!$A$2:$C$" & SourceLastRow & ",3,0)"
'if segment is found in column C, and you also want the results in column C the line above will return the desired value
'Close the source workbook, don't save any changes
sourceBook.Close False
Application.ScreenUpdating = True
End Sub
As I understand you want to populate the VLOOKUP formula into the table but only for the rows where is a data?
Assuming that Column "A" - CompanyID and "B" - Company Name is always populated and there are no gaps between the records you can make excel to drag the formula for you
Here is the code for you
Sub test()
Dim maxRow As Long
Dim DataWS As Worksheet
Dim lookupWS As Worksheet
'Set your data sheet
Set DataWS = Worksheets("Sheet1")
'Set your lookup sheet
Set lookupWS = Worksheets("Sheet2")
maxRow = lookupWS.Range("A1").End(xlDown).Row
'Populate formula
'Company Name
lookupWS.Range("B2").Formula = "=VLOOKUP($A2," & DataWS.Name & "!$A:$F,2,FALSE)" 'Make sure you change "2" to correct value in your case
'Segment
lookupWS.Range("C2").Formula = "=VLOOKUP($A2," & DataWS.Name & "!$A:$F,3,FALSE)" 'Make sure you change "3" to correct value in your case
'Sector
lookupWS.Range("D2").Formula = "=VLOOKUP($A2," & DataWS.Name & "!$A:$F,4,FALSE)" 'Make sure you change "4" to correct value in your case
'Channel
lookupWS.Range("E2").Formula = "=VLOOKUP($A2," & DataWS.Name & "!$A:$F,5,FALSE)" 'Make sure you change "5" to correct value in your case
'Account Type
lookupWS.Range("F2").Formula = "=VLOOKUP($A2," & DataWS.Name & "!$A:$F,6,FALSE)" 'Make sure you change "6" to correct value in your case
'Drag formula
Range("B2:F2").AutoFill Destination:=Range("B2:F" & maxRow), Type:=xlFillCopy
End Sub
Make sure you change your range arrays appropriately and it should work for you.

VBA Copy two ranges and combine them, then save in text file

I need to copy two ranges of cells from two separate worksheets in one file, and combine them then save then into a text file. I only know how to save one range of cells into txt. file like the code below.
Dim LastRow As Long
Dim Count As Range
LastRow = Range("K" & Sheets("Reports").Rows.Count).End(xlUp).Row
Dim wbText As Workbook
Dim wsReports As Worksheet
Set wbText = Workbooks.Add
Set wsReports = ThisWorkbook.Worksheets("Reports")
With wsReports
.Range("Q2" & ":Q" & LastRow).Copy wbText.Sheets(1).Range("A1")
End With
Application.DisplayAlerts = False
With wbText
.SaveAs Filename:="P:\Newsletter Email.txt", FileFormat:=xlText
.Close False
End With
This code copies column F in sheet Reports in to the text file, but I also need to copy column L from sheet Reports1 into the text file. I know
RangeCombined = Union(Range1, Range2)
Could combine two ranges, how can I integrate this code into this situation?
Thanks in advance.
Try
Dim LastRow As Long
Dim LastRow1 As Long
Dim Count As Range
Dim wbText As Workbook
Dim wsReports As Worksheet
Dim wsReports1 As Worksheet
Set wbText = Workbooks.Add
Set wsReports = ThisWorkbook.Worksheets("Reports")
Set wsReports1 = ThisWorkbook.Worksheets("Reports1")
LastRow = wsReports.Range("K" & wsReports.Rows.Count).End(xlUp).Row
LastRow1 = wsReports1.Range("K" & wsReports1.Rows.Count).End(xlUp).Row
wsReports.Range("Q2" & ":Q" & LastRow).Copy wbText.Sheets(1).Range("A1")
wsReports1.Range("F2" & ":F" & LastRow1).Copy wbText.Sheets(1).Range("B1")
Application.DisplayAlerts = False
With wbText
.SaveAs Filename:="P:\Newsletter Email.txt", FileFormat:=xlText
.Close False
End With
This will copy column Q of Reports into column A of the output, and column F of Reports1 into column B of the output.
Alternatively, if you want column F of Reports1 to appear below column Q of Reports, change the Copy statements to be:
wsReports.Range("Q2" & ":Q" & LastRow).Copy wbText.Sheets(1).Range("A1")
wsReports1.Range("F2" & ":F" & LastRow1).Copy wbText.Sheets(1).Range("A" & LastRow)
(If there are the same number of rows in both Reports and Reports1, the above can be simplified a bit.)
I think the best way is to save the file to a path while printing to it. Try this
Dim FilePath As String
Dim lCol As String
Dim fCol As String
Dim fRange As String
Dim lRange As String
Dim wsReports As Worksheet
Dim wsReports1 As Worksheet
Set wsReports = ThisWorkbook.Worksheets("Reports")
Set wsReports1 = ThisWorkbook.Worksheets("Reports1")
FilePath = "P:\Newsletter Email.txt"
fRange = "F2:F" & LastRow
lRange = "L2:L" & LastRow
'Will create the file if it does not exist
Open FilePath For Output As #1
With wsReports
.Range("Q2" & ":Q" & lastrow).Copy wbText.Sheets(1).Range("A1")
For i = 0 To lastrow
fCol = .Cells(i, "F")
Print #1, fCol
Next i
End With
With wsReports1
For i = 0 To lastrow
lCol = .Cells(i, "L")
Print #1, lCol
Next i
End With
'Make sure to close it or you'll have difficulties opening the file
Close #1

Copy data from one workbook to another (tab to workbook)

I am trying to transfer data from one workbook to another. Workbook A has 48 tabs of different data and I have 48 excel files that I need to copy-paste to specific columns. the tab name and file names are matching so that is why I set the names range. I keep getting syntax error from the open statement (set y)
and another error at the ws1-select-range line. would you help me to under stand what I am doing wrong?
Sub Transfer()
Dim x As Workbook, y As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
Dim names As String
Set x = ThisWorkbook
For a = 2 To 49
names = ThisWorkbook.Sheets(1).Range("A" & a).Text
' getting compile error: Expected end of statement
set y = workbook.Open Filename:=Thisworkbook.Path & "/" & names & ".xlsx"
Set ws1 = x.Sheets(names)
Set ws2 = y.Sheets("Equipment")
'updated code as below then getting run time error '1004': Copy method of range class failed
ws1.Range("B2:B200").Copy ws2.Range("A3")
ws1.Range("c2:c200").Copy ws2.Range("B3")
ws1.Range("f2:f200").Copy ws2.Range("C3")
ws1.Range("g2:g200").Copy ws2.Range("D3")
Next a
End Sub
I appreciate your time and advice.
So I updated some code and I kind of make it work. :)
Sub Transfer()
Dim x As Workbook, y As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
Dim names As String
Dim lastrow As Integer
Dim a As Integer
Set x = ThisWorkbook
For a = 2 To 49
names = ThisWorkbook.Sheets(1).Range("A" & a).Text
Set y = Workbooks.Open("C:\Documents\Work\" & names & ".xlsx")
Set ws1 = x.Sheets(names)
Set ws2 = y.Sheets(2)
lastrow = ws1.Cells(Rows.Count, 6).End(xlUp).Row
ws1.Range("B2:B" & lastrow).Copy ws2.Range("A3")
ws1.Range("C2:C" & lastrow).Copy ws2.Range("B3")
ws1.Range("F2:F" & lastrow).Copy ws2.Range("C3")
ws1.Range("G2:G" & lastrow).Copy ws2.Range("D3")
ws1.Range("H2:H" & lastrow).Copy ws2.Range("E3")
ws1.Range("I2:I" & lastrow).Copy ws2.Range("F3")
ws1.Range("J2:J" & lastrow).Copy ws2.Range("G3")
ws1.Range("L2:L" & lastrow).Copy ws2.Range("H3")
ws1.Range("M2:M" & lastrow).Copy ws2.Range("I3")
ws1.Range("N2:N" & lastrow).Copy ws2.Range("J3")
ws1.Range("O2:O" & lastrow).Copy ws2.Range("K3")
y.Save
y.Close
Next a
End Sub