Converting formula to VBA - vba

I am very new to VBA, I have a formula with me, Which I want in Macro.
I used Macro recording to have the vba, but the Problem is it is generating for each row, making the vba code complex. also, it Displays the formula in formula bar.
I have two Sheets , sheet 1 (BW) and sheet2(CW). I want the code in sheet 1. it Looks for ID in sheet 2 and copy the values from Ad to Au of sheet1.
I have tried, to some extent to implement my formula to code.
=IF(IFERROR(VLOOKUP($B2;CW!$B$2:$AU591;30;FALSE);"0")=0;" ";IFERROR(VLOOKUP($B2;CW!$B$2:$AU591;30;FALSE);""))
Sub lookupo()
Dim totalrows As Long
Dim totalrowssh2 As Long
totalrows = Sheets("BW").Cells(Rows.Count, "A").End(xlUp).Row
totalrowsSht2 = Sheets("CW").Cells(Rows.Count, "A").End(xlUp).Row
sheets("BW").Range("AD2:AD" & Totalrows).formula = Application.WorksheetFunction.If(Iferror(Apllication.Vlookup(sheets("BW").Range("B2:B" &totalrowssht2), Sheets("CW").Range("$A:$AU"),29,False),"0"))=0,"")
End Sub
I am struck how i should implement the second formula in line. Could someone help me to overcome with a VBA code.

No need to use Application.WorksheetFunction. You can directly assign the formula string to a cell.
Is this what you are trying?
Sub lookupo()
Dim BWlRow As Long, CWlRow As Long
Dim Sformula As String
Dim wsBW As Worksheet, wsCW As Worksheet
Set wsBW = Sheets("BW"): Set wsCW = Sheets("CW")
BWlRow = wsBW.Cells(wsBW.Rows.Count, "A").End(xlUp).Row
CWlRow = wsCW.Cells(wsCW.Rows.Count, "A").End(xlUp).Row
Sformula = "=IF(IFERROR(VLOOKUP($B2;CW!$B$2:$AU" & _
CWlRow & _
";30;FALSE);""0"")=0;"" "";IFERROR(VLOOKUP($B2;CW!$B$2:$AU" & _
CWlRow & _
";30;FALSE);""""))"
wsBW.Range("AD2:AD" & BWlRow).Formula = Sformula
End Sub
Use this if ; is not your separator.
Sformula = "=IF(IFERROR(VLOOKUP($B2,CW!$B$2:$AU" & _
CWlRow & _
",30,FALSE),""0"")=0,"" "",IFERROR(VLOOKUP($B2,CW!$B$2:$AU" & _
CWlRow & _
",30,FALSE),""""))"
How can i extend the same till column AU. ? – Mikz 4 mins ago
You will have to loop through the columns and amend the formula before applying it.
Sub lookupo()
Dim BWlRow As Long, CWlRow As Long, i As Long
Dim Sformula As String
Dim wsBW As Worksheet, wsCW As Worksheet
Set wsBW = Sheets("BW"): Set wsCW = Sheets("CW")
BWlRow = wsBW.Cells(wsBW.Rows.Count, "A").End(xlUp).Row
CWlRow = wsCW.Cells(wsCW.Rows.Count, "A").End(xlUp).Row
For i = 30 To 47 '~~> Col AD to AU
Sformula = "=IF(IFERROR(VLOOKUP($B2,CW!$B$2:$AU" & _
CWlRow & _
"," & _
i & _
",FALSE),""0"")=0,"" "",IFERROR(VLOOKUP($B2,CW!$B$2:$AU" & _
CWlRow & _
"," & _
i & _
",FALSE),""""))"
With wsBW
.Range(.Cells(2, i), .Cells(BWlRow, i)).Formula = Sformula
End With
Next i
End Sub

Application.WorksheetFunction is a good idea, if you think that one day your Excel would be used outside an English speaking country. Furthermore, you should not be worrying about the formula separators this way, Excel sets them automatically.
Having said that, try to use Option Explicit at the top of your file (this highlights variable definition errors immediately) and then correct your code and then fix a bit of it like this:
totalrowssh2 - make sure that totalrowssht2 is the same
everywhere.
Apllication.Vlookup - take a look here and fix the grammer mistake.
Then try the code below and fix it a bit:
Sub lookupo()
Dim totalrows As Long
Dim totalrowssh2 As Long
totalrows = Worksheets("BW").Cells(Rows.Count, "A").End(xlUp).Row
totalrowssh2 = Worksheets("CW").Cells(Rows.Count, "A").End(xlUp).Row
Worksheets(1).Range("AD2:AD" & totalrows).Formula = Application.WorksheetFunction.If(WorksheetFunction.IfError(Application.VLookup(Sheets(1).Range("B2:B" & totalrowssh2), Sheets("CW").Range("$A:$AU"), 29, False), "0") = 0, "")
End Sub

Related

Vba search and paste solution

i would like to come up with vba sub that searching value from one specified cell (job) across all sheets and then pastes rows but only with selected columns. If value not found any error message instead paste value.
I know it's bigger project but I'm fresh so try to my best.
As far i have solution for whole rows:
Sub TEST()
Dim tws As String
Dim l_row As String
Dim l_rowR As String
Dim job As String
Dim i As Integer
Set tws = ThisWorkbook.Sheets("Data")
tws.Range("A20") = "STATS:"
job = tws.Range("B5")
lastRow = Worksheets("Sheet1").Range("E" & Rows.Count).End(xlUp).Row
lastRowRpt = tws.Range("A" & Rows.Count).End(xlUp).Row
For i = 3 To lastRow
If Worksheets("Sheet1").Range("E" & i).Value = job And _
Worksheets("Sheet1").Range("D" & i).Value = "x2" Then
Worksheets("Sheet1").Rows(i).Copy
lastRowRpt = tws.Range("A" & Rows.Count).End(xlUp).Row
tws.Range("A" & lastRowRpt + 1).Select
tws.Paste
End If
Next i
End Sub

Different sheet pasting

I have written a code which gives me the errors (if any cell is non numeric) in a separate sheet called "Error_sheet".
But the output is a bit clumsy as it gives me non numeric cell address in a confusing fashion. Like the errors will not be pasted one after another. There will be some blanks in between if there are more than one non Numeric cells.
Sub Test()
Dim LastRow As Long, i As Long
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To LastRow
If IsNumeric(Range("A" & i).Value) Then
Else
Sheets("Error").Range("A" & Row).Value = "Error in" & i & " row of ColumnNAme"
Row = Row + 1
End If
Next i
End Sub
It gives me output like shown below but can I get the output like Error in 7,14 rows of column name in a desired cell of "Error_sheet".
[![Output][1]][1]
[1]: https://i.stack.imgur.com/JqXwq.png
My understanding of what you've written is that you want something like this.
Option Explicit
Sub Test()
' Unqualified book/sheet below, means code will always run the isnumeric check on the cells of the active sheet. Is that what you want? '
Dim LastRow As Long
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
Dim Index as long
Dim i As Long
Dim NonNumericRows() as string
Redim NonNumericRows(1 to lastrow)
For i = 2 To LastRow
If not(IsNumeric(Range("A" & i).Value)) Then
Index = index + 1
NonNumericRows(Index) = cstr(i)
End if
Next i
Redim preserve NonNumericRows(1 to index)
Sheets("Error").Range("A1").Value = "Error in row(s): " & strings.join(nonnumericrows,", ") & " of ColumnNAme"
End Sub
Hope it works or helps.
Like QHarr suggested, using Option Explicit is normally a good idea, and try not to use VBA operators as variables.
Also when working with more than 1 sheet, its best to define each in the code. I dont know what your first sheet is called, so please change the line: Set shSource = Sheets("Sheet1") to suit:
Option Explicit
Sub SubErrorSheet()
Dim lr As Long, i As Long
Dim shSource As Worksheet, shError As Worksheet
Set shSource = Sheets("Sheet1")
Set shError = Sheets("Error")
lr = shSource.Range("A" & Rows.count).End(xlUp).Row
For i = 2 To lr
If Not IsNumeric(shSource.Range("A" & i).Value) Then
shError.Range("A" & Rows.count).End(xlUp).Offset(1, 0).Value = "Error in row " & i & " of ColumnNAme"
End If
Next i
End Sub

How to count used cells in a row if some cells are blank

How to count used cell in row if some cells are blank
Sub atest()
Dim LR As Long, i As Long
Dim LC As Long, s As Long
Dim myrange As String
LR = Range("B" & Rows.Count).End(xlUp).Row
LC = Range((LR) & Column.Count).End(xlToLeft).Column
Just use the native COUNTA() function, you can access this via the WorksheetFunction Class
cellCount = WorksheetFunction.CountA(LR.EntireRow)
No point re-inventing the wheel when there is already a perfectly good function to accomplish this.
How to count used cell in row if some cells are blank
This should count only used cells
Sub CountUsedCells()
Dim CountUsedCells As Long
CountUsedCells = Worksheets("Sheet1").Range("A:A").Cells.SpecialCells(xlCellTypeConstants).count
MsgBox " Total used cells are " & CountUsedCells
End Sub
Rather than starting at the end of the data to get your max number of columns, it's easier to do this on headers using Cells()
Sub atest()
Dim LR As Long, _
i As Long, _
LC As Long, _
s As Long, _
MyRange As String
With Sheets("Sheet1")
LR = .Rows(.Rows.Count).End(xlUp).Row
'Or
'LR = .Range("B" & Rows.Count).End(xlUp).Row
LC = .Range(.Cells(1, Columns.Count)).End(xlToLeft).Column
'Or
'LC = .Range(.Cells(LR,Columns.Count)).End(xlToLeft).Column
End With
End Sub

EXCEL-VBA hyperlinks conversion inquiry

Dim RITMRow As Long
Dim ws1 As Worksheet
Dim RITMstorage As String
Dim LastRow As Long
Set ws1 = Sheets("Tracker")
LastRow = ws1.Range("A" & Rows.Count).End(xlUp).Row
For RITMRow = 2 To LastRow
RITMstorage = ws1.Range("A" & RITMRow).Value
ws1.Range("A" & RITMRow).Hyperlinks.Add Anchor:=ws1.Range("A" & RITMRow), _
Address:="https://site.site.com/sc_req_item.do?sys_id=" & RITMstorage, _
ScreenTip:="Request Number", _
TextToDisplay:=RITMstorage
Next RITMRow
With ws1
.Cells.Font.Size = "8"
.Cells.RowHeight = 11.25
.Cells.Font.Name = "Calibri"
.Range("A1").EntireRow.RowHeight = 25
End With
hi, my code above works in converting a column to hyperlinks. as you can see, it's quite a bit inefficient as everytime i click the button, it goes back and converts everything to hyperlinks again, even those that are already hypelinks. please point me in the right direction. i need a way to detect the columns that already has a hyperlink the offset by 1 then convert the non hyperlink cell.
thanks in advance.
Just try to get the address from the cell and check to see if you get an error:
Dim url As String
Dim isLink As Boolean
For RITMRow = 2 To LastRow
On Error Resume Next
url = ws1.Range("A" & RITMRow).Hyperlinks(1).SubAddress
isLink = (Err.Number = 0)
On Error GoTo 0
If Not isLink Then
RITMstorage = ws1.Range("A" & RITMRow).Value
ws1.Range("A" & RITMRow).Hyperlinks.Add Anchor:=ws1.Range("A" & RITMRow), _
Address:="https://site.site.com/sc_req_item.do?sys_id=" & RITMstorage, _
ScreenTip:="Request Number", _
TextToDisplay:=RITMstorage
End If
Next RITMRow

how to append data to existing excel file using vb.net?

i have code which finds the last non empty row in an existing excel file. i want to insert data from 5 textbox to the next 5cells in column. i dont know how to code it. please help me, here is my code:
With xlWorkSheet
If EXL.WorksheetFunction.CountA(.Cells) <> 0 Then
lRow = .Cells.Find(What:="*", _
After:=.Range("A2"), _
LookAt:=Excel.XlLookAt.xlPart, _
LookIn:=Excel.XlFindLookIn.xlFormulas, _
SearchOrder:=Excel.XlSearchOrder.xlByRows, _
SearchDirection:=Excel.XlSearchDirection.xlPrevious, _
MatchCase:=False).Row
Else
lRow = 1
End If
End With
Here are two different solutions to your problem. I like the second better because you can determine a lastrow from any column and if you cared reference it to another column.
Dim nextrow As Integer = excel.Rows.End(XlDirection.xlDown).Row + 1
Dim ws As Worksheet = excel.ActiveSheet
Dim nRow = ws.Range("A" & ws.Rows.Count).End(XlDirection.xlUp).Row + 1
Then all you have to do to assign a value is:
excel.Range("A" & nRow).Value = "test"
excel.range("B" & nRow).value = "adjacent column"
If you want to loop it to 5 cells below that then do:
Dim ws As Worksheet = excel.ActiveSheet
Dim lRow = ws.Range("A" & ws.Rows.Count).End(XlDirection.xlUp).Row
For i = 1 To 5
excel.Range("A" & lRow).Offset(i, 0).Value = "variable here"
Next