How can I modify the execution of the vlookup based upon a specific value. I want it to execute the Vlookup only if the output sheet (sheet 2) cell (Q2 to AB2) contains "Forecast" otherwise skip column if labeled "Actual" in the relative cell.
Finally I want to copy and paste any cells in the Column Q to AB that contain the vlookup forumla. I believe this can be accomplished using the String function.
Sub MakeFormulas()
Dim SourceLastRow As Long
Dim OutputLastRow As Long
Dim sourceSheet As Worksheet
Dim outputSheet As Worksheet
Dim X As Long
'names of our worksheets
Set sourceSheet = Worksheets("Sheet1")
Set outputSheet = Worksheets("Sheet2")
'Determine last row of source
With sourceSheet
SourceLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
With outputSheet
'Determine last row in col C
OutputLastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
For X = 2 To OutputLastRow
If InStr(1, .Range("C" & X), "PO Materials") + InStr(1, .Range("C" & X), "PO Labor") > 0 Then
'Apply formula
.Range("Q" & X & ":AB" & X).Formula = _
"=VLOOKUP($E" & X & ",'" & sourceSheet.Name & "'!$A$2:$L$" & SourceLastRow & ",Match(Q$1,'" & sourceSheet.Name & "'!$A$1:$AD$1,0),0)"
End If
Next
End With
End Sub
Sheet 2 Screenshot
I will just hardcode a bit:
For Y = 17 To 28 'Q to AB
For X = 2 To OutputLastRow
If InStr(1, .Range("C" & X), "PO Materials") + InStr(1, .Range("C" & X), "PO Labor") > 0 And Cells(2, Y) = "Forecast" Then
'Apply formula
.Cells(X, Y).Formula = _ 'cell at row X, column Y
"=VLOOKUP($E" & X & ",'" & sourceSheet.Name & "'!$A$2:$L$" & SourceLastRow & ",Match(" & cells(1,Y).address & ",'" & sourceSheet.Name & "'!$A$1:$AD$1,0),0)"
End If
Next
Next
It breaks down to check the second cell in each column first before applying the formula
Related
I need to create a macro that can take data in columns F through I and autofill it down to the last cell in column E that has data in it. The code below almost does what I need it to do. However, I want to be able to use this macro with different data further down in columns F:I
Dim lastrow As Long
lastrow = Range("e" & Rows.Count).End(xlUp).Row
Dim x(1 To 4) As Variant
With ThisWorkbook.Sheets("sheet1")
x(1) = Range("f2")
x(2) = Range("g2")
x(3) = Range("H2")
x(4) = Range("I2")
.Range("F3:i3").Formula = x
.Range("f3:i" & lastrow).FillDown
End With
Like this:
With ThisWorkbook.Sheets("sheet1")
lastrow = Range("E" & Rows.Count).End(xlUp).Row
For i = 3 To lastrow
.Range("F" & i).Formula = .Range("F2").Formula
.Range("G" & i).Formula = .Range("G2").Formula
.Range("H" & i).Formula = .Range("H2").Formula
.Range("I" & i).Formula = .Range("I2").Formula
Next i
End With
So I have an macro for a file in which there are three columns. The macro detect specific columns and rows in another workbook for my three columned file. See image below for workbook 1.
Then it should look at the rows and columns of workbook 2 (see below) and find the position of column A and B that match from workbook 1 and paste in the corresponding value of column C into workbook 2 (the value 1). However I keep getting #VALUE! error and I don't know why its happening.
FYI - the columns continue to 51 but cant fit in the image
Below is the code for this macro:
Sub Location()
Dim i As Long, k As Long, ws1 As Worksheet, ws2 As Worksheet
Dim lastrow As Long
Set ws1 = Workbooks("Book3.xlsm").Worksheets("Sheet1")
Set ws2 = Workbooks("Book4.xlsm").Worksheets("Sheet1")
lastrow = ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row
For i = 2 To ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Row
For k = 2 To ws2.Cells(1, ws2.Columns.Count).End(xlToLeft).Column
ws2.Cells(i, k).Value = ws2.Evaluate("IFERROR(INDEX(" & ws1.Range("B1:B" & lastrow).Address(0, 0, xlA1, 1) & ",AGGREGATE(15,6,ROW(" & ws1.Range("A1:A" & lastrow).Address(0, 0, xlA1, 1) & ")" & _
"/((" & ws1.Range("A1:A" & lastrow).Address(0, 0, xlA1, 1) & " = " & ws2.Cells(i, 1).Address(0, 0) & ")*(" & ws1.Range("C1:C" & lastrow).Address(0, 0, xlA1, 1) & "=" & _
ws2.Cells(1, k).Address(0, 0) & ")),1)),"""")")
Next k
Next i
End Sub
Any help? Thanks.
I should have thought of this formula first:
Sub Location()
Dim i As Long, k As Long, ws1 As Worksheet, ws2 As Worksheet
Dim LastRow As Long
Set ws1 = Workbooks("Book3.xlsm").Worksheets("Sheet1")
Set ws2 = Workbooks("Book4.xlsm").Worksheets("Sheet1")
LastRow = ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row
For i = 2 To ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Row
For k = 2 To ws2.Cells(1, ws2.Columns.Count).End(xlToLeft).Column
ws2.Cells(i, k).Value = Application.WorksheetFunction.SumIfs(ws1.Range("C1:C" & LastRow), ws1.Range("A1:A" & LastRow), ws2.Cells(i, 1), ws1.Range("B1:B" & LastRow), ws2.Cells(1, k))
If ws2.Cells(i, k).Value = 0 Then ws2.Cells(i, k).Value = ""
Next k
Next i
End Sub
So in column A and column B there are two sets of values from workbook 1 that should match with the position in workbook 2.
**WORKBOOK 1**
column A column B column C
a 1 32
b 2 45
f 6 12
g 9 55
e 5 99
On this diagram, X marks location where the cells from workbook 1 match the position in workbook 2. The columns represent column A and the rows represent column B. Once the location has been found the corresponding value in column C will be pasted into the location.
**WORKBOOK 2**
1 2 5 9 6
_ _ _ _ _
a |X
b | X
f | X
g | X
e | X
FYI - the rows and columns in this example are from workbook 1, not the default column and row numbers.
My attempt, but what would you use instead of putting "B2" for the location?
Sub Location()
Dim i as Long, k as Long, ws1 as Worksheet, ws2 as Worksheet
Set ws1 = Workbooks("A").Worksheets("Sheet 1")
Set ws2 = Workbooks("B").Worksheets("Sheet 2")
For i = 1 to 5
variable = ws1.Cells(i, 1) && ws1.Cells(i, 2)
For k = 1 to 5
If ws2.Cells(i, 1) && ws2.Cell(1, i) = variable Then
ws1.Range("C1").Copy
ws2.Range("B2").Paste
End if
Next k
Next I
End Sub
Desired output
1 2 5 9 6
_ _ _ _ _
a |32
b | 45
f | 12
g | 55
e | 99
Any suggestions on how to begin this? Also I know the vlookup function exists but using VBA code would this be achievable?
Errors:
And this is the input, column B in this image is acting as column C in the example.
Input code:
Sub Location()
Dim i As Long, k As Long, ws1 As Worksheet, ws2 As Worksheet
Dim lastrow As Long
Set ws1 = Workbooks("Copy of Retrofit Monthly Invoicing 2017.xlsm").Worksheets("Sheet1")
Set ws2 = Workbooks("Book4").Worksheets("Sheet1")
lastrow = ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row
For i = 2 To ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Row
For k = 2 To ws2.Cells(1, ws2.Columns.Count).End(xlToLeft).Column
ws2.Cells(i, k).Value = ws2.Evaluate("IFERROR(INDEX(" & ws1.Range("B1:B" & lastrow).Address(0, 0, xlA1, 1) & ",AGGREGATE(15,6,ROW(" & ws1.Range("A1:A" & lastrow).Address(0, 0, xlA1, 1) & ")" & _
"/((" & ws1.Range("A1:A" & lastrow).Address(0, 0, xlA1, 1) & " = " & ws2.Cells(i, 1).Address(0, 0) & ")*(" & ws1.Range("C1:C" & lastrow).Address(0, 0, xlA1, 1) & "=" & _
ws2.Cells(1, k).Address(0, 0) & ")),1)),"""")")
Next k
Next i
End Sub
If you are not adverse to formula:
=IFERROR(INDEX(Sheet1!$C:$C,AGGREGATE(15,6,ROW(Sheet1!$A$1:$A$5)/((Sheet1!$A$1:$A$5 = $A2)*(Sheet1!$B$1:$B$5=B$1)),1)),"")
In the first cell, then copy and drag over and down.
Then just use Evaluate and the formula:
Sub Location()
Dim i As Long, k As Long, ws1 As Worksheet, ws2 As Worksheet
Dim lastrow As Long
Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")
lastrow = ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row
For i = 2 To ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Row
For k = 2 To ws2.Cells(1, ws2.Columns.Count).End(xlToLeft).Column
ws2.Cells(i, k).Value = ws2.Evaluate("IFERROR(INDEX(" & ws1.Range("C1:C" & lastrow).Address(0, 0, xlA1, 1) & ",AGGREGATE(15,6,ROW(" & ws1.Range("A1:A" & lastrow).Address(0, 0, xlA1, 1) & ")" & _
"/((" & ws1.Range("A1:A" & lastrow).Address(0, 0, xlA1, 1) & " = " & ws2.Cells(i, 1).Address(0, 0) & ")*(" & ws1.Range("B1:B" & lastrow).Address(0, 0, xlA1, 1) & "=" & _
ws2.Cells(1, k).Address(0, 0) & ")),1)),"""")")
Next k
Next i
End Sub
Do you need VBA? You can do this with an Array formula.
I'm using Sheets, but just have both workbooks open and use that, to fix the references:
Data is like this on Sheet1:
Then, in your Sheet2 (or other workbook, etc), place this in A1, and enter with CTRL+SHIFT+ENTER
=IFERROR(INDEX(Sheet1!$C$1:$C$5,MATCH(ROW()&SUBSTITUTE(ADDRESS(1,COLUMN(),4),"1",""),Sheet1!$B$1:$B$5&Sheet1!$A$1:$A$5,0)),"")
Drag over and down:
I have the below code which searches for specific text based on the Col header, like Col O, Col P etc. Instead I want to search using the respective column name in Row 1.
I have added the column name in the code comments.
Sub PassFailValidationandupdatecomments()
Dim Rng As Range, cl As Range
Dim LastRow As Long, MatchRow As Variant
With Sheets("DRG")
LastRow = .Cells(.Rows.count, "E").End(xlUp).Row '"E" - Live ASIN
Set Rng = .Range("E2:E" & LastRow) ' "E" - Live ASIN
End With
With Sheets("Latency")
For Each cl In .Range("B2:B" & .Cells(.Rows.count, "B").End(xlUp).Row) ` "B" - ASIN
MatchRow = Application.Match(cl.Value, Rng, 0)
If Not IsError(MatchRow) Then
Select Case Sheets("DRG").Range("AH" & MatchRow + 1).Value ' "AH" - Final Test Result
.Range("O" & cl.Row).Value = "Pass" '"O" - Pass/Fail
Case "Pended"
.Range("O" & cl.Row).Value = "Fail"'"O" - Pass/Fail
Case "In progress"
.Range("O" & cl.Row).Value = "In progress"'"O" - Pass/Fail End Select
If Not Sheets("DRG").Range("E" & MatchRow + 1).Value = vbNullString Then .Range("P" & cl.Row).Value = .Range("P" & cl.Row).Value & IIf(Not .Range("P" & cl.Row).Value = vbNullString, ";", "") & Sheets("DRG").Range("S" & MatchRow + 1).Value ' "E" - Live ASIN ; "P" - Comments ; "S" - App Trail
End If
Next cl
End With
This is a follow on from How do I get all the different unique combinations of 3 columns using VBA in Excel?
It almost what i need, however, my requirements is that it sums the third column which will contain figures instead of yes/no
Sub sample()
Dim ws As Worksheet
Dim lRow As Long, i As Long, j As Long
Dim col As New Collection
Dim Itm
Dim cField As String
Const deLim As String = "#"
Set ws = ThisWorkbook.Sheets("Sheet1")
With ws
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
For i = 2 To lRow
cField = .Range("A" & i).Value & deLim & _
.Range("B" & i).Value & deLim & _
.Range("C" & i).Value
On Error Resume Next
col.Add cField, CStr(cField)
On Error GoTo 0
Next i
i = 2
.Range("A1:C1").Copy .Range("F1")
.Range("I1").Value = "Count"
For Each Itm In col
.Range("F" & i).Value = Split(Itm, deLim)(0)
.Range("G" & i).Value = Split(Itm, deLim)(1)
.Range("H" & i).Value = Split(Itm, deLim)(2)
For j = 2 To lRow
cField = .Range("A" & j).Value & deLim & _
.Range("B" & j).Value & deLim & _
.Range("C" & j).Value
If Itm = cField Then nCount = nCount + 1
Next
.Range("I" & i).Value = nCount
i = i + 1
nCount = 0
Next Itm
End With
End Sub
This code was originally added by
Siddharth Rout
try this (follows comments)
Option Explicit
Sub Main()
Dim i As Long
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
For i = 4 To Range("A" & Rows.Count).End(xlUp).Row '<-- change 4 and "A" to your data actual upleftmost cell row and column
dict(cells(i, 1).Value & "|" & cells(i, 2).Value) = dict(cells(i, 1).Value & "|" & cells(i, 2).Value) + cells(i, 3).Value '<--| change 3 to your actual "column to sum up" index
Next
With Range("G3").Resize(dict.Count) '<-- change "G3" to your actual upleftmost cell to start writing output data from
.Value = Application.Transpose(dict.Keys)
.TextToColumns Destination:=.cells, DataType:=xlDelimited, Other:=True, OtherChar:="|"
.Offset(, 2).Resize(dict.Count).Value = Application.Transpose(dict.Items) '<--| change 2 to your actual column offset where to start writing summed values form
End With
End Sub