Hope you're doing great, need help with below code that is supposed to match first column from 2 files then vlookup and copy paste the matched results. the problem is that i'm limited by vlookup range that only works for one column so i tried to make a loop to make it work on multiple number of cells as shown below but it's not working, any help or hints would be really welcomed, Thanks.
edit
the problem lies where iis used in the funcStr for the vlooukp table range and column's number, i need the range to be increased and column number to constinatly change to get the whole row copied instead.
Sub solution()
Dim oldRow As Integer
Dim newRow As Integer
Dim lrow_output As Integer
Dim WB_Input As Workbook
Dim WB_Output As Workbook
Dim WS_Input As Worksheet
Dim WS_Output As Worksheet
Dim funcStr As String
Dim i As Integer
Set WB_Input = Workbooks("File.xlsm")
Set WB_Output = Workbooks("output1.xlsx")
Set WS_Input = WB_Input.Worksheets("input")
Set WS_Output = WB_Output.Worksheets("Sheet1")
With WS_Output
lrow_output = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
For i = 2 To 6
With WS_Input
funcStr = "=IFERROR(VLOOKUP(" & Cells(1, 1).Address(False, False) & "," & "'[" & WB_Input.Name & "]" & .Name & "'!" & Range(.Columns(1), .Columns(i)).Address & ",i,0),"""")"
End With
With WS_Output
.Cells(1, i).Formula = funcStr
.Cells(1, i).Copy
Range(.Cells(1, i), .Cells(lrow_output, i)).PasteSpecial xlPasteFormulas
WS_Output.Calculate
Range(.Cells(1, i), .Cells(lrow_output, i)).Copy
Range(.Cells(1, i), .Cells(lrow_output, i)).PasteSpecial xlPasteValues
Application.CutCopyMode = False
End With
Next i
End Sub
Related
I've updated my code which now works as intended, however I would like set filterList1 and filterList2 equal to cell C5 and C6 respectively on my "Assumptions" worksheet. How can I do this?
I tried setting filterList1 = Worksheets("Assumptions").Cells(5, "C").Value and filterList2 = Worksheets("Assumptions").Cells(6, "C").Value but doing so seemed to break most lines in the code.
Any suggestions would be really helpful!
Sub Refresh_PlanIDs()
Dim filterList1 As Variant
filterList1 = Array("2019")
filterCol1 = 68 'or whatever column contains the IDs
Dim filterList2 As Variant
filterList2 = Array("Travel")
filterCol2 = 69 'or whatever column contains the names
Dim sourceWS As Worksheet
Set sourceWS = Sheets("report1603894994415")
Dim destinationWS As Worksheet
Set destinationWS = Sheets("Demand Summary by Plan (2)")
lastrowSrc = sourceWS.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
lastrowDest = destinationWS.Range("B" & Rows.Count).End(xlUp).Row
sourceWS.AutoFilterMode = False
sourceWS.Range("$A$1:$DA" & lastrowSrc).AutoFilter Field:=filterCol1, _
Criteria1:=filterList1, Operator:=xlFilterValues
sourceWS.Range("$A$1:$DA" & lastrowSrc).AutoFilter Field:=filterCol2, _
Criteria1:=filterList2, Operator:=xlFilterValues
sourceWS.Range("BH2:BH" & lastrowSrc).SpecialCells _
(xlCellTypeVisible).Copy _
Destination:=destinationWS.Cells(lastrowDest + 1, 2)
If sourceWS.AutoFilterMode Then sourceWS.ShowAllData
Dim MyRange As Range
Dim LastRow2 As Long
'Remove Duplicates
LastRow2 = ActiveSheet.Range("B" & Rows.Count).End(xlUp).Row
Set MyRange = ActiveSheet.Range("B10:B" & LastRow2)
MyRange.RemoveDuplicates Columns:=1, Header:=xlYes
End Sub
I am trying to paste values from a bunch of tables into one long list. I have the tables spread across different sheets and the number of rows changes, but the columns do not. Then I am also trying to paste a string value that tells what sheet it came from, but having trouble with the active cell part of the code.
When I first tried it, it did not compile, hence why I came here, to figure out why it did not compile. Going back and forth with urdearboy, below, I was able to get the correct code working here.
I have the following:
sub copypaste()
Dim ws1 as worksheet
dim ws2 as worksheet
dim mas as worksheet
Set ws1 =ThisWorkbook.Sheets("Sheet1")
Set ws2=ThisWorkbook.Sheets("Sheet2")
Set mas=ThisWorkbook.Sheets("Master") 'where I create my list
For Each ws In Worksheets
If ws.Name <> mas.Name Then
LRow = mas.Range("A" & mas.Rows.Count).End(xlUp).Offset(1, 0).Row
wsLRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
ws.Range("A2:A" & wsLRow - 1).Copy
mas.Range("A" & LRow).PasteSpecial Paste:=xlPasteValues
ws.Range("B2:B" & wsLRow - 1).Copy
mas.Range("B" & LRow).PasteSpecial Paste:=xlPasteValues
mas.Range(mas.Cells(LRow, 4), mas.Cells(wsLRow + LRow - 2, 4)) = ws.Name 'I need my sheet value in the fourth column, not the third, but simply change the col coordinate in the Cells equation above
End If
Next ws
'In order to figure out the sheet name, I used the following:
Dim rng As Range
Set rng = mas.Range("D2", Range("D2").End(xlDown))
For Each Cell In rng
If Cell.Value = "Sheet 1" Then
Cell.Value = "S1"
ElseIf Cell.Value = "Sheet 2" Then
Cell.Value = "S2"
End If
Next Cell
end sub
This will loop through all sheets, with the exception of Master, and import the values on Column A to Master accompanied by the origin of the data (sheet name).
Option Explicit for good measure.
Option Explicit
Sub copypaste()
Dim mas As Worksheet: Set mas = ThisWorkbook.Sheets("Master")
Dim ws As Worksheet, LRow As Long, wsLRow As Long
Application.ScreenUpdating = False
For Each ws In Worksheets
If ws.Name <> mas.Name Then
LRow = mas.Range("A" & mas.Rows.Count).End(xlUp).Offset(1).Row
wsLRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
ws.Range("A2:A" & wsLRow).Copy mas.Range("A" & LRow)
mas.Range(mas.Cells(LRow, 2), mas.Cells(wsLRow + LRow - 2, 2)) = ws.Name
End If
Next ws
Application.ScreenUpdating = True
End Sub
To paste values change
ws.Range("A2:A" & wsLRow).Copy mas.Range("A" & LRow)
to this
ws.Range("A2:A" & wsLRow).Copy
mas.Range("A" & LRow).PasteSpecial xlPasteValues
My objective is to compare data in a range in Ws1 with data in a range in ws2, and copy those values that repeat in ws3.
Ideally I would like to copy the value found and the rest of the information to the right of that cell (from ws2), but for now I am happy just copying the value found.
I decided to use a loop for this but I was getting an infinite looping, and now that I re-summarize; I am getting:
range of object _ global failed" error and it points to: "With
Range(ws3.cells(i, 1))
Sub quicktests()
Dim ws1, ws2, ws3 As Worksheet
Dim ColNum, ColNum2 As Long
Dim rng, Range2 As Range
Dim lRow1, lRow2, lCol2 As Integer
ColNum = 9
ColNum2 = 14
lRow1 = 347
Set ws2 = Sheets("Filled today")
With ws2
lCol2 = .cells(1, .Columns.Count).End(xlToLeft).Column
'MsgBox lCol2
lRow2 = .cells(.Rows.Count, 1).End(xlUp).Row
'MsgBox lRow2
Set Range2 = .Range(.cells(1, ColNum2), .cells(lRow2, lCol2))
End With
Set ws3 = Sheets("Duplicates filled and hiring")
Set ws1 = Sheets("Reconciliated Recruiment Plan")
For i = 1 To lRow1
With ws1
Set rng = .cells(i, ColNum)
End With
With Range(ws3.cells(i, 1))
.Formula = "=VLookup(rng, Range2, ColNum, False)"
.Value = .Value
End With
Next i
End Sub
Looking at just the part with the VLOOKUP:
You can't used range with one cells() it needs a begining and an end, remove the Range wrapper.
The Vlookup; You need to remove the vba part from the string and concatenate it.
With ws3.cells(i, 1)
.Formula = "=VLookup(" & rng.Address(0,0) & "," & Range2.Address(0,0) & "," & ColNum & ", False)"
.Value = .Value
End With
I'm trying to write a short macro that includes a line that averages a range of cells. In each worksheet that I want to run the macro in the range of cells is a different length.
After running the macro the cell E1 contains "=AVERAGE(Rng)"
Dim homeSheet As Worksheet
Set homeSheet = ActiveSheet
Dim lastRow As Long
Dim Rng As Range
lastRow = Range("A" & Rows.Count).End(xlUp).Row
Set Rng = Range("B2:B" & lastRow)
Range("E1").Formula = "=Average(Rng)"
Range("E2").Formula = "=STDEV(Rng)"
Range("E3").Select
ActiveWindow.SmallScroll Down:=-2
End Sub
I've also tried
Range("E1").Formula = "=Average(Range("B2:B" & lastRow))"
without trying to use Set Rng = Range("B2:B" & lastRow)
You need to use Rng.Address in your formulas. Try to change your code into this:
Sub Avg()
Dim homeSheet As Worksheet
Set homeSheet = ActiveSheet
Dim lastRow As Long
Dim Rng As Range
lastRow = Range("A" & Rows.Count).End(xlUp).Row
Set Rng = Range("B2:B" & lastRow)
Range("E1").Formula = "=Average(" & Rng.Address & ")"
Range("E2").Formula = "=STDEV(" & Rng.Address & ")"
Range("E3").Select
End Sub
If you were to use the second method you have tried, you would need to change that line of code to:
Range("E1").Formula = "=Average(" & Range("B2:B" & lastRow).Address & ")"
I Have a Column C that has names in all its cells and another Column E that has the same company name in all its cells I need to append the names in Column C to the company name in column E
Thanks
Ex:
ColC ColE
Bob SampleCo
Sally SamplCo
I get
ColC ColE
Bob SampleCo Bob
Sally SamplCo Sally
I am trying but failing with
Sub CompanyName()
Dim LastRow As Long
Dim Ws As Worksheet
Dim rRange As range
Set rRange = range("E2")
rRange.Select
Set Ws = Sheets("WP_SubjectList_Ready")
LastRow = Ws.range("F" & Ws.Rows.Count).End(xlUp).Row
Ws.range("E2:E" & LastRow).FormulaR1C1 = "=rRange &RC[-1]"
range("E2:E" & LastRow).Copy
range("E2:E" & LastRow).PasteSpecial xlPasteValues
End Sub
Code
Sub CompanyName()
Dim LastRow As Long
Dim Ws As Worksheet
Set Ws = Sheets("WP_SubjectList_Ready")
LastRow = Ws.Range("E" & Ws.Rows.Count).End(xlUp).Row
Ws.Range("F2:F" & LastRow).FormulaR1C1 = "= RC[-1] & "" "" & RC[-3]"
End Sub
If you want the output in Column E its not possible using FormulaR1C1.
Any formula which work for excel interface will work for FormulaR1C1.
With that i mean (considering the image) in cell F2 you can manullay enter a formula = E2 & " " & C2 which will give you desired output. But if you enter in cell E2the formula as =E2 & " " & C2 the cell E2 will loose its value and this may even lead to circular reference issue.
It can be achieved using below code.
Sub CompanyName()
Dim LastRow As Long
Dim Ws As Worksheet
Dim rng As Range, cell As Range
Set Ws = Sheets("WP_SubjectList_Ready")
LastRow = Ws.Range("E" & Ws.Rows.Count).End(xlUp).Row
Set rng = Ws.Range("E2:E" & LastRow)
For Each cell In rng
cell = cell & " " & cell.Offset(0, -2)
Next
End Sub
Here's some code that should help you with what you want...I don't typically use ranges for loops because it's easier to use .Cells(row, col) for me, but anyways:
EDIT: Added Sub Opening/Closing Syntax and edited to use WS instead of ActiveSheet so it's closer to what you want
Sub CompanyName()
Dim WS as Worksheet
Dim vRow
Dim vRowCount As Integer
Set WS = Sheets("WP_SubjectList_Ready")
'Gets Row # of Last Row for Column E
vRowCount = Range("E" & Rows.Count).End(xlUp).row
'Assuming Both Columns have the same row count and you have a header row
For vRow = 2 To vRowCount
WS.Cells(vRow, 5).Value = WS.Cells(vRow, 5).Value & " " & WS.Cells(vRow, 3).Value
Next vRow
End Sub