I have this code but can't seems to solve the problem,
Sub IndMat()
Dim wh1 As Worksheet
Dim wh2 As Worksheet
Set wh1 = Sheets("SAS")
Set wh2 = Sheets("Sheet1")
Dim y As VariantDim x As LongDim lr1 As Long
Dim lr2 As Long
Dim rng1 As Range
Dim rng2 As Range
lr1 = wh1.Cells(Rows.Count, 5).End(xlUp).Row
lr2 = wh2.Cells(Rows.Count, 2).End(xlUp).Row
Set rng1 = wh2.Range("a2:a25")
Set rng2 = wh2.Range("b2:b25")
For i = 2 To lr1
y = application.Index(rng1, Application.Match(wh1.Cells(i, 5), rng2, 0))
Next i
End Sub
The error exposes when running
y = application.Index(rng1, Application.Match(wh1.Cells(i, 5), rng2, 0))
Related
This code works, but it puts the values at the bottom of Sheet2(Table2), instead of next available row in table2. Any suggestions would be appreciated. Thanks
https://drive.google.com/file/d/19fZ6GLGtVNd13I-GTgLVjnfKlzrwx05U/view?usp=sharing
Sub Macro()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Sheet2")
Dim LastRow As Long
Dim s As Long
Dim myRow As Long
s = ws.Range("A" & Application.Rows.Count).End(xlUp).Row
LastRow = Sheets("Sheet1").Cells(Rows.Count, "I").End(xlUp).Row
For myRow = 2 To LastRow
If Sheets("Sheet1").Cells(myRow, "I") = "INACTIVE" Then
ws.Range("A" & s + 1) = Sheets("Sheet1").Cells(myRow, "A")
ws.Range("B" & s + 1) = Sheets("Sheet1").Cells(myRow, "B")
ws.Range("C" & s + 1) = Sheets("Sheet1").Cells(myRow, "C")
ws.Range("D" & s + 1) = Sheets("Sheet1").Cells(myRow, "I")
End If
Next myRow
End Sub
Copying Data From One Excel Table to Another
Dealing with Excel tables in VBA can be quite tricky. This is a simple user-friendly version. You could dive much deeper into it by using (an array of) the table headers in the loop and whatnot.
Option Explicit
Sub Macro()
Dim sws As Worksheet: Set sws = ThisWorkbook.Worksheets("Sheet1")
Dim stbl As ListObject: Set stbl = sws.ListObjects("Table1")
Dim dws As Worksheet: Set dws = ThisWorkbook.Worksheets("Sheet2")
Dim dtbl As ListObject: Set dtbl = dws.ListObjects("Table2")
Dim sCell As Range
Dim srrg As Range
Dim drrg As Range
Dim r As Long
For Each sCell In stbl.ListColumns("Status").DataBodyRange
r = r + 1
If StrComp(CStr(sCell.Value), "INACTIVE", vbTextCompare) = 0 Then
Set srrg = stbl.ListRows(r).Range
Set drrg = dtbl.ListRows.Add.Range
drrg.Cells(1).Value = srrg.Cells(1).Value
drrg.Cells(2).Value = srrg.Cells(2).Value
drrg.Cells(3).Value = srrg.Cells(3).Value
drrg.Cells(4).Value = srrg.Cells(9).Value
End If
Next sCell
End Sub
the below code should work as s variable is inside the loop.
P.S.
Updated the code to match your example.
Also, the sheet2 has table, so the last row was not detected correctly by End(xlUp).Row
The problem was also with myRow =2
Sub Macro()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet2")
Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Sheets("Sheet1")
Dim LastRow As Long
Dim s As Long
Dim myRow As Long
LastRow = ThisWorkbook.Sheets("Sheet1").Cells(Rows.Count, "I").End(xlUp).Row
For myRow = 1 To LastRow
s = ws.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row + 1
If ws1.Cells(myRow, "I") = "INACTIVE" Then
ws.Range("A" & s & ":C" & s) = ws1.Range("A" & myRow & ":C" & myRow).Value
ws.Range("D" & s) = "INACTIVE"
End If
Next myRow
MsgBox "OK"
End Sub
Thought it would be as simple as, but somewhere i am wrong please help! So I am trying to find the values from rng1 in rng2 and have the output next to rng1
Thanks in advance
Sub FindValuestest()
Dim wb As Workbook, wks1, wks2 As Worksheet, rng1, rng2 As Range
Dim lRow1, lRow2 As Long
Dim v, n, r As Variant
On Error Resume Next
Set wb = ThisWorkbook
Set wks1 = wb.Worksheets("FEPR")
Set wks2 = wb.Worksheets("EQUIP")
lRow1 = wks1.Cells(wks1.Rows.Count, "B").End(xlUp).Row
lRow2 = wks2.Cells(wks2.Rows.Count, "A").End(xlUp).Row
Set rng1 = wks1.Range("B2", Cells(Rows.Count, "B").End(xlUp))
Set rng2 = wks2.Range("A1", Cells(Rows.Count, "A").End(xlUp))
lRow1 = lRow1 - 1
For v = 1 To lRow1
For n = 1 To lRow1
If n = rng2.Find(n, , xlValues, xlWhole, , , False) And rng2.Cells(n, 2) = "Commodity Tracking Bag Scanner" Then
'Debug.Print n
rng1.Cells(n, 2) = rng1.Cells(n) & " Scanner OK"
End If
Next
Next
For v = 1 To lRow1
For n = 1 To lRow1
If n = rng2.Find(n, , xlValues, xlWhole, , , False) And rng2.Cells(, 2) = "Radio" Then
rng1.Cells(n, 3) = rng1.Cells(n) & " Radio OK"
End If
Next
Next
End Sub
Match Values
Option Explicit
Sub FindValuestest()
' Workbook
Dim wb As Workbook: Set wb = ThisWorkbook
' Source
Dim sws As Worksheet: Set sws = wb.Worksheets("EQUIP")
Dim sLast As Long: sLast = sws.Cells(sws.Rows.Count, "A").End(xlUp).Row
Dim srg As Range: Set srg = sws.Range("A1:A" & sLast)
' Destination
Dim dws As Worksheet: Set dws = wb.Worksheets("FEPR")
Dim dLast As Long: dLast = dws.Cells(dws.Rows.Count, "B").End(xlUp).Row
Dim drg As Range: Set drg = dws.Range("B2:B" & dLast)
' Additional Variables
Dim cIndex As Variant
Dim i As Long
' Write
Application.ScreenUpdating = False
For i = 1 To dLast
cIndex = Application.Match(drg.Cells(i).Value, srg, 0)
If IsNumeric(cIndex) Then
If srg.Cells(cIndex).Offset(, 1) _
= "Commodity Tracking Bag Scanner" Then
drg.Cells(i).Offset(, 1).Value = drg.Cells(i) & " Scanner OK"
ElseIf srg.Cells(cIndex).Offset(, 1) = "Radio" Then
drg.Cells(i).Offset(, 2).Value = drg.Cells(i) & " Radio OK"
End If
End If
Next i
Application.ScreenUpdating = True
End Sub
Sub IndMat()
Dim wh1 As Worksheet
Dim wh2 As Worksheet
Set wh1 = Sheets("DATA")
Set wh2 = Sheets("Dashboard")
Dim y As Variant
Dim x As Long
Dim lr1 As Long
Dim lr2 As Long
Dim rng1 As Range
Dim rng2 As Range
Dim i As Integer
‘This is the formula I want to use but in an application function ‘”=IFERROR (INDEX(DATA!$B$2:$B$257;SMALL(IF(DATA! $D$2:$D$257=DATAMATCH!$M$7;ROW(DATA!$D$2:$D$257)-MIN(ROW(DATA!$D$2:$D$257)) +1);ROWS($B$13:$I15)));"")”
Lr1 = wh1.Cells(Rows.Count, 5).End(xlUp).Row
Lr2 = wh2.Cells(Rows.Count, 2).End(xlUp).Row
Set rng1 = wh1.Range("D2:D" & lr1)
Set rng2 = wh2.Range("A2:A" & lr1)
For i = 2 To lr2
wh2.Cells(i, 13) = Application.Index(rng2, Application.Small(Application.if (rng1 = wh2.Cells(12, 1), Application.Row(rng1), Application.Min(Application.Row(rng1)) + 1), Application.Rows("B13")), "")
Next
End Sub
Kind of newbie using application function so would be very pleased if someone could help me translate this function to application function..
I know similar questions have been asked in the past, but looking through those posts, I haven't been able to find a solution to the following issue.
I have 2 subs that use Bloomberg API formulas. In the second (Setup_2) the variable LastRow1 is dependent on Setup_1 having populated to work properly.
Using checkStatus_1 and checkStatus_2 I can run each of the 2 setup subs independently, but when I try to create a separate sub calling them, it doesn't work, as the data that LastRow1 depends on isn't there.
Here is the relevant code:
Sub Setup_1()
Dim ws1 As Worksheet
Set ws1 = Worksheets("Returns")
ws1.Cells(2, 1).Formula = "=BDS(Control!B4,""INDX_MWEIGHT_HIST"",""END_DATE_OVERRIDE"",TEXT($A$1,""YYYYMMDD""))"
ws1.Cells(1, 4).Formula = "=BDH(A2&"" Equity"",""DAY_TO_DAY_TOT_RETURN_GROSS_DVDS"",$B$1,$A$1,""dir=h"")"
ws1.Cells(3, 4).Formula = "=BDH(A3&"" Equity"",""DAY_TO_DAY_TOT_RETURN_GROSS_DVDS"",$B$1,$A$1,""dir=h"",""dts=h"")"
checkStatus_1
End Sub
Sub Setup_2()
Dim ws1 As Worksheet
Set ws1 = Worksheets("Returns")
Dim LastRow1 As Long
LastRow1 = ws1.Cells(Rows.Count, 1).End(xlUp).Row
ws1.Cells(3, 4).Formula = "=BDH(A3&"" Equity"",""DAY_TO_DAY_TOT_RETURN_GROSS_DVDS"",$B$1,$A$1,""dir=h"",""dts=h"")"
ws1.Cells(3, 4).AutoFill Destination:=ws1.Range(ws1.Cells(3, 4), ws1.Cells(LastRow1, 4))
checkStatus_2
End Sub
Sub Setup_3()
Dim ws1 As Worksheet
Set ws1 = Worksheets("Returns")
Dim LastRow1 As Long
Dim LastCol1 As Long
Dim LCol As String
LastRow1 = ws1.Cells(Rows.Count, 1).End(xlUp).Row
LastCol1 = ws1.Cells(1, Columns.Count).End(xlToLeft).Column
LCol = Split(Cells(, LastCol1).Address, "$")(1)
ws1.Cells(2, 3).Formula = "=(STDEV.S(D2:" & LCol & "2)*SQRT(252))/100"
ws1.Cells(2, 3).AutoFill Destination:=ws1.Range(ws1.Cells(2, 3), ws1.Cells(LastRow1, 3))
End Sub
Sub checkStatus_1()
Dim ws1 As Worksheet
Dim rng As Range
Dim c As Range
Set ws1 = Worksheets("Returns")
Set rng = Application.Union(ws1.Cells(2, 1), ws1.Cells(1, 4), ws1.Cells(3, 4))
For Each c In rng
If "#N/A Requesting Data..." = c Or "#N/A Invalid Securiity" = c Then
Application.OnTime (Now + TimeValue("00:00:02")), "checkStatus_1"
Exit Sub
End If
Next c
End Sub
Sub checkStatus_2()
Dim ws1 As Worksheet
Dim rng As Range
Dim c As Range
Dim LastRow1 As Long
Set ws1 = Worksheets("Returns")
LastRow1 = ws1.Cells(Rows.Count, 1).End(xlUp).Row
Set rng = ws1.Range(ws1.Cells(3, 4), ws1.Cells(LastRow1, 4))
For Each c In rng
If "#N/A Requesting Data..." = c Then
Application.OnTime (Now + TimeValue("00:00:02")), "checkStatus_2"
Exit Sub
End If
Next c
End Sub
Sub CompareAndHighlight()
Dim xRange As Range, yRange As Range
Dim xCell As Range, yCell As Range
Dim Found As Range
Dim wsX As Worksheet: Set wsX = ThisWorkbook.Sheets("Sheet1")
Dim wsY As Worksheet: Set wsY = ThisWorkbook.Sheets("Sheet2")
LR1 = wsX.Range("A" & wsX.Rows.Count).End(xlUp).Row
LR2 = wsY.Range("A" & wsY.Rows.Count).End(xlUp).Row
Set xRange = wsX.Range("A1:A" & LR1)
Set yRange = wsY.Range("A1:A" & LR2)
For Each xCell In xRange
Set Found = yRange.Find(xCell.Value)
If Found Is Nothing Then
xCell.Interior.Color = RGB(255, 0, 0)
End If
Set Found = Nothing
Next xCell
End Sub
I use above code to compare two excel sheets. i do comparison only between only column "A".
What I want to do is compare other column sequentially like compare further "B" to "b" and "c" to "c".
how can i do that by changing the code.
I like to use the sheet.cells() destination so you can easily use integers to call out both rows and columns
Sub CompareAndHighlight()
Dim xRange, yRange, xCell, yCell, Found As Range
Dim i, LR1, LR2 As Integer
Dim wsX As Worksheet: Set wsX = ThisWorkbook.Sheets("Sheet1")
Dim wsY As Worksheet: Set wsY = ThisWorkbook.Sheets("Sheet2")
For i = 1 To 3 'Set to the number of the last column you want to run the comparison
LR1 = wsX.Cells(wsX.Rows.Count, i).End(xlUp).Row
LR2 = wsY.Cells(wsY.Rows.Count, i).End(xlUp).Row
Set xRange = wsX.Range(wsX.Cells(1, i), wsX.Cells(LR1, i))
Set yRange = wsY.Range(wsY.Cells(1, i), wsY.Cells(LR2, i))
For Each xCell In xRange
Set Found = yRange.Find(xCell.Value)
If Found Is Nothing Then
xCell.Interior.Color = RGB(255, 0, 0)
End If
Set Found = Nothing
Next xCell
Next i
End Sub
Modify if needed and try:
Option Explicit
Sub test()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim rngToSearch As Range, FindPosition As Range
Dim Lastrow1 As Long, Lastrow2 As Long, ColumnToSearch As Long, i As Long, y As Long
Dim strToSearch As String
Set ws1 = ThisWorkbook.Worksheets("Sheet1")
Set ws2 = ThisWorkbook.Worksheets("Sheet2")
Lastrow1 = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row
Lastrow2 = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row
For i = 1 To Lastrow1
For y = 1 To 3
strToSearch = ws1.Cells(i, y).Value
If y = 1 Then
ColumnToSearch = 1
ElseIf y = 2 Then
ColumnToSearch = 2
ElseIf y = 3 Then
ColumnToSearch = 3
End If
Set rngToSearch = ws2.Range(ws2.Cells(1, ColumnToSearch), ws2.Cells(Lastrow2, ColumnToSearch))
Set FindPosition = rngToSearch.Find(strToSearch)
If FindPosition Is Nothing Then
ws1.Cells(i, y).Interior.Color = RGB(255, 0, 0)
End If
Next y
Next i
End Sub