Loop with VBA Vlookup, with dynamic cell value - vba

Sub tabelvul()
Dim nr(2)
For i = 2 To 31
nr(1) = Range("AA" & i).Value
nr(2) = Range("AN" & i).Value
If nr(2) = 0 Then
' do nothing
Else
Range(nr(1)).Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(nr(2),Tabel80[[Kolom1]:[Inschrijver]],2)"
End If
Next i
End Sub
The first value nr(1) has is B4, so i do get the formula of Vlookup in B4, however he is searching for nr(2) and not the corresponding value of nr(2), which is 1, so I want the formula to look for 1 in the table.

I'm pretty sure there are other things that could be improved in your code, but you should change:
"=VLOOKUP(nr(2),Tabel80[[Kolom1]:[Inschrijver]],2)"
To this:
"=VLOOKUP(" & nr(2) & ",Tabel80[[Kolom1]:[Inschrijver]],2)"
Well it looks like you are wanting to enter the Vlookup on a range until nr(2) = Range("AN" & i).value = 0, so I don't know why you would use an array at all, if I knew what you were trying with more detail, could probably make it even better, but with what I know, this could do:
Sub tabelvul()
For i = 2 To 31
If Range("AN" & i).Value = 0 Then
' do nothing
Else
Range("AA" & i).FormulaR1C1 = _
"=VLOOKUP(" & Range("AN" & i).Value & ",Tabel80[[Kolom1]:[Inschrijver]],2)"
End If
Next i
End Sub

Maybe you should change "=VLOOKUP(nr(2),Tabel80[[Kolom1]:[Inschrijver]],2)" into "=VLOOKUP(" & nr(2) & ",Tabel80[[Kolom1]:[Inschrijver]],2)"

Related

VBA -- variable in .formula

is there a more elegant (simpler) way to put a variable in .formula? I don't want to use .formulaR1C1
I have this code:
Range("C8").Select
Selection.End(xlDown).Select
PosR = ActiveCell.Row
KonR = PosR - 2
Range("N" & PosR).Select
aAddress = Range("$N$9").Address & ":" & Range("$N$" & KonR).Address
ActiveCell.Formula = "=SUM(" & aAddress & ")"
Obviously I want to put =SUM($N$9:$N$101) (101 is the last cell minus 2) into that cell and this code does the job. But I just want to be sure that this is the easiest way to do this.
The easiest way is to skip all that selecting and those variables
PosR = Range("C8").End(xlDown).Row
Range("N" & PosR).Formula = "=SUM($N$9:$N$" & PosR - 2 & ")"
Edit: to be more explicit, the easiest way is to use FormulaR1C1 but you said you didn't want to, so...
You can use the code below (without using Select and ActiveCell:
PosR = Range("C8").End(xlDown).Row
KonR = PosR - 2
Range("N" & PosR).Formula = "=SUM(" & Range("$N$9").Address & ":" & Range("$N$" & KonR).Address & ")"
Or, the much simplier version:
Range("N" & PosR).Formula = "=SUM($N$9:$N$" & KonR & ")"
Well you should be trying to avoid using Select in VBA. You've made the actual inclusion of a variable in the .Formula about a simple as it gets, but your whole code could be simplified:
PosR = Range("C8").End(xlDown).Row
Range("N" & PosR).Formula = "=SUM($N$9:$N$" & PosR - 2 & ")"
Really you should be fully qualifying your ranges too, like so
With ThisWorkbook.Sheets("Sheet1")
PosR = .Range("C8").End(xlDown).Row
.Range("N" & PosR).Formula = "=SUM($N$9:$N$" & PosR - 2 & ")"
End With
And if you have blank cells in column C then your use of xlDown will fail to find the last cell. You may want to look at ways of finding the last cell in VBA or simply use
' Again, preferably fully qualified
Range("C" & Rows.Count).End(xlUp).Row
Range("$N$9").Address gives exactly "$N$9".
Range("N9").Address gives the same. Thus, it is a bit overwork. Check out the first two debug.print in the sample below.
Thus, once you calculate the last row and assign value to it lngLast, it is possible to get the formula like this:
"=SUM(N9:N" & lngLast & ")"
Option Explicit
Public Sub TestMe()
Dim strA As String
Dim lngLast As Long
strA = Range("$N$9").Address
Debug.Print strA = "$N$9"
strA = Range("N9").Address
Debug.Print strA = "$N$9"
lngLast = Range("N" & Rows.Count).End(xlUp).Row - 2
ActiveCell.Formula = "=SUM(N9:N" & lngLast & ")"
End Sub
Good morning, everyone :)

Decreasing complexity of loop & Find- VBA

I have written the following code; both Sheet 1 and Sheet 2 are rather big sheet with lots of data. Run this Macro is extremely time comsuming ( It has a high complexity I guess). I'm quite new at VBA and therefore having trouble make the code more effective.
Sub Find()
Dim rgFound As Range
Dim Index As Long: Index = 6
Dim Row as Long
Do While Worksheets("Sheet2").Cells(Index, "D").Value > 0
Sheets("Sheet1").Select
Set rgFound = Range("A1:A20000").Find(Worksheets("Sheet2").Cells(Index, "D").Value)
If Not rgFound Is Nothing Then
Row = rgFound.Row
Worksheets("Sheet1").Range("E" & Row).Value = Worksheets("Sheet2").Range("AA" & Index).Value
Worksheets("Sheet1").Range("F" & Row).Value = Worksheets("Sheet2").Range("AB" & Index).Value
Worksheets("Sheet1").Range("G" & Row).Value = Worksheets("Sheet2").Range("AC" & Index).Value
Worksheets("Sheet1").Range("H" & Row).Value = Worksheets("Sheet2").Range("Z" & Index).Value
Worksheets("Sheet1").Range("J" & Row).Value = Worksheets("Sheet2").Range("AG" & Index).Value
Worksheets("Sheet1").Range("I" & Row).Value = Worksheets("Sheet2").Range("AD" & Index).Value
Else
' Function // Not done yet
End If
Index = Index + 1
Loop
End Sub
Is the built in Find function effective? The loop loops trough roughly 250-400 values. Any Ideas?

Correcting formula in vba excel

I want to create a macro that check all the cells of a column and if the first two characters of a cell is "BB" then i want the macro to extract three characters from the cell and paste it to the next column but a the corresponding row.
But my formula after the if clause is not working.
this is what i have done since:
Sub test()
Dim lmid As String
Dim srange, SelData, ExtBbFor As String
Dim lastrow As Long
Dim i, icount As Integer
lastrow = ActiveSheet.Range("B30000").End(xlUp).Row
srange = "G1:G" & lastrow
SelData = "A1:G" & lastrow
Range(srange).Formula = "=mid(E1,1,3)"
For i = 1 To lastrow
If InStr(1, LCase(Range("E" & i)), "bb") <> 0 Then
Range("G" & i).Formula = "=mid("E & i", 4, 3)"
End If
Next i
End Sub
thanks in advance
Try with below. It will work
Range("G" & i).Value = Mid(Range("E" & i), 4, 3)
If the cell is not limited to 7 then you need as below
Range("G" & i).Value = "=Mid(E" & i & ", 3, " & Len(E & "& i & ") & ")"
It will extract from the 3rd character up to the last character in a cell.
Your syntax is wrong where you're trying to concatenate strings, I think you mean to use:
Range("G" & i).Formula = "=MID(E" & i & ",4,3)"
Based on your code I think this will do the exact same thing without having to loop or declare any variables:
Sub test()
With Range("G1:G" & Cells(Rows.Count, 2).End(xlUp).Row)
.FormulaR1C1 = "=IF(UPPER(LEFT(RC[-2],2))=""BB"",MID(RC[-2],4,3),"""")"
.Value = .Value
End With
End Sub

Cataloging Problematic Cells by Hyperlink Copying

I'm trying to flag problematic cells and link the cell hyperlink to another cell to review later. Here is my code. Not all of the code is visible. I Called "i" and "j" as long. The error occurs on newLink = Range("AL" & i).Hyperlinks(1).Address claiming that it is "out of range." I think this means that it is calling something that doesn't exist, but to be honest i'm not sure.
If Range("AK" & i).Value = "On" Then
If Range("AL" & i).Value = 0 And Range("AM" & i).Value = 0 Then
Range("AL" & i, "AM" & i).Interior.ColorIndex = 6
'Cells("AL" & i) = H.Address'
ErrorCount = ErrorCount + 1
Dim newLink As String
newLink = Range("AL" & i).Hyperlinks(1).Address
Range("IV" & j).Hyperlinks.Add anchor:=Range("IV" & j), Address:=Range("IV" & j)
Range("IV" & j).Hyperlinks(1).Address = newLink
j = j + 1
End If
If there is no hyperlink attached to a cell then Range("foo").Hyperlinks.Count will return 0 and therefore you will get an 'Out of range' error.
You just need to wrap the newLink = ... statement in an If to check if there is already a hyperlink there. E.g.
If Range("AL" & i).Hyperlinks.Count = 1 Then
newLink = Range("AL" & i).Hyperlinks(1).Address
Else
'what else will you do?
End If

select multiple rows using variable

I have a loop that runs through the worksheet and keeps track of works where the guy is named "bill" then memorizes those rows and i want to copy them over to the next sheet.
my problem is that
'works
'Range("525:525,504:504,502:502,497:497,496:496,495:495,494:494,493:493,492:492,491:491,478:478,471:471,453:453,450:450,449:449,448:448,447:447,446:446,445:445,444:444,443:443,442:442,441:441,440:440,439:439,438:438,437:437,436:436,427:427,129:129").Select
but when i use a variable to create that list of rows, it doesnt select the rows
Dim accountsArray(2, 2) As String
accountsArray(1, 0) = "test"
accountsArray(1, 1) = "bill"
Dim rngCounter As String
rngCounter = Chr(34)
For i = ActiveSheet.Cells(ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row, 1).Row To 2 Step -1
'save rows with bill
If InStr((ActiveSheet.Cells(i, 2).Text), accountsArray(1, 1)) <> 0 Then
If Len(rngCounter) < 2 Then rngCounter = rngCounter & i & ":" & i Else rngCounter = rngCounter & "," & i & ":" & i
End If
Next i
rngCounter = rngCounter & Chr(34)
'works
'Range("525:525,504:504,502:502,497:497,496:496,495:495,494:494,493:493,492:492,491:491,478:478,471:471,453:453,450:450,449:449,448:448,447:447,446:446,445:445,444:444,443:443,442:442,441:441,440:440,439:439,438:438,437:437,436:436,427:427,129:129").Select
'does not work
Range(rngCounter).Select
Selection.Copy
Sheets.Add after:=ActiveSheet
ActiveSheet.Paste
The way the code currently is written you're effectively calling this:
Range("""525:525,504:504,502:502,497:497,496:496,495:495,494:494,493:493,492:492,491:491,478:478,471:471,453:453,450:450,449:449,448:448,447:447,446:446,445:445,444:444,443:443,442:442,441:441,440:440,439:439,438:438,437:437,436:436,427:427,129:129""").Select
So take out the Chr(34) (double quotes) that you are adding to the beginning and end of your string and it'll work fine.