I have the following code That I need to loop for ~100 rows. Instead of writing out for each row, is there a way to add a loop feature in here to repeat until a row is blank? I am having trouble figuring out the Do While Loop feature and incorporating it within the code below. Thanks!
Sub Excel_INDIRECT_Function()
'declare a variable
Dim ws As Worksheet
Set ws = Worksheets("TOC")
'apply the Excel INDIRECT function
ws.Range("$F8").Formula = "=INDIRECT($W8&""Q24"")"
ws.Range("$G8").Formula = "=INDIRECT($W8&""Q30"")"
ws.Range("$I8").Formula = "=INDIRECT($W8&""I56"")"
ws.Range("$J8").Formula = "=INDIRECT($W8&""Q34"")"
ws.Range("$K8").Formula = "=INDIRECT($W8&""D7"")"
ws.Range("$L8").Formula = "=INDIRECT($W8&""L56"")"
ws.Range("$M8").Formula = "=INDIRECT($W8&""M56"")"
ws.Range("$N8").Formula = "=INDIRECT($W8&""N56"")"
ws.Range("$O8").Formula = "=INDIRECT($W8&""O56"")"
ws.Range("$R8").Formula = "=INDIRECT($W8&""D6"")"
End Sub
I am looking to get this accomplished for multiple rows without writing this code ~100 times. Thanks so much.
I'm not sure you need a loop.
This code will put the formulas in columns F, G etc. from row 8 down to the last row of data in column W.
Sub Excel_INDIRECT_Function()
'declare a variable
Dim ws As Worksheet
Dim lngLastRow As Long
Set ws = Worksheets("TOC")
lngLastRow = ws.Range("W" & Rows.Count).End(xlUp).Row
'apply the Excel INDIRECT function
ws.Range("F8:F" & lngLastRow).Formula = "=INDIRECT($W8&""Q24"")"
ws.Range("G8:G" & lngLastRow).Formula = "=INDIRECT($W8&""Q30"")"
ws.Range("I8:I" & lngLastRow).Formula = "=INDIRECT($W8&""I56"")"
ws.Range("J8:J" & lngLastRow).Formula = "=INDIRECT($W8&""Q34"")"
ws.Range("K8:K" & lngLastRow).Formula = "=INDIRECT($W8&""D7"")"
ws.Range("L8:L" & lngLastRow).Formula = "=INDIRECT($W8&""L56"")"
ws.Range("M8:M" & lngLastRow).Formula = "=INDIRECT($W8&""M56"")"
ws.Range("N8:N" & lngLastRow).Formula = "=INDIRECT($W8&""N56"")"
ws.Range("O8:O" & lngLastRow).Formula = "=INDIRECT($W8&""O56"")"
ws.Range("R8:R" & lngLastRow).Formula = "=INDIRECT($W8&""D6"")"
End Sub
Related
I want to create a macro that inserts new column with column name (BL & Container) and then concatinates 2 column in newly inserted column.
In this column I named BL & Container is a new column added my macro.
Further I want the macro to concatenate the values present in column H and F macro should find column H and F by column name and concatenate the them in to newly inserted column I.
My codes below
Sub insert_conc()
Dim ColHe As Range
Dim FindCol As Range
Dim con As String
Dim x As Long
Set FindCol = Range("1:1") 'Looks in entire first row.
Set ColHe = FindCol.Find(what:="BL/AWB/PRO", After:=Cells(1, 1))
With ActiveWorkbook.Worksheets("WE")
ColHe.Offset(0, 1).EntireColumn.Insert
ColHe.Offset(0, 1).Value = "WER"
'x = Range("A" & Rows.Count).End(xlUp).Row
con = "=H2&""-""&F2"
ColHe.Resize(x - 1).Formula = con
End With
Application.ScreenUpdating = True
End Sub
[![Error in code][3]][3]
In this code line " con = "=H2&""-""&F2"" please advise how do I update column nameinstead of H2 and F2 macro should find columna H2 and F2 header name and then concatinate the values in newly inserted column I BL & container. Please advise.
Please, use the next adapted code:
Sub insert_conc()
Dim sh As Worksheet, x As Long, ColHe As Range
Dim FindCol As Range, con As String, firstCell As Range
Set sh = Worksheets("LCL")
x = sh.Range("A" & sh.rows.count).End(xlUp).row
Set FindCol = sh.Range("1:1") 'Looks in entire first row.
Set ColHe = FindCol.Find(what:="BL/AWB/PRO", After:=sh.cells(1, 1))
ColHe.Offset(0, 1).EntireColumn.Insert
ColHe.Offset(0, 1).value = "BL & Container"
Set firstCell = ColHe.Offset(1, -2) ' determine the cell to replace F2
con = "=" & ColHe.Offset(1).Address(0, 0) & "&" & firstCell.Address(0, 0)
ColHe.Offset(1, 1).Resize(x - 1).Formula = con
End Sub
It is also good to know that using With ActiveWorkbook.Worksheets("LCL") makes sense only if you use it in the code lines up to End with. And your code did not do that... It should be used before, in order to deal with the appropriate sheet, even if it was not the active one.
I've only started using VBa and I keep getting an Expected: end of statement error.
I'm not sure what the issue is. I need the vba to loop an if statement with a vlookup and an iferror. I can't set the range because the list will be dynamic.
The more I try to fix the code myself the more messy it gets. I've scoured the internet for help.
Any and all help would be appreciated.
The formula is running on the MasterData tab and pulling from the DataDrop tab.
Sub COAB()
Dim i As Range
Set i = Sheets("MasterData").Range("D2")
Dim i2 As Range
Dim i3 As Range
Set i2 = Sheets("MasterData").Range("W2")
Set i3 = Sheets("MasterData").Range("X2")
Dim MasterData As Worksheet
Dim DataDrop As Worksheet
Set MasterData = ThisWorkbook.Sheets("MasterData")
Set DataDrop = ThisWorkbook.Sheets("DataDrop")
Do Until IsEmpty(i)
i2 = "=IFERROR(IF(VLOOKUP(" & MasterData.Range("D2").Address(0, 0) & ","
& DataDrop.Range("A:C") & ",3,FALSE)" <> "NULL" & ", & ""Charged Off"" & ","
& "Active "),"& Active")"
i3 = "=IFERROR(VLOOKUP(RC[-20],'DataDrop'!A:C,2,FALSE),0)"
Set i = i.Offset(1)
Set i2 = i2.Offset(1, 0)
Set i3 = i3.Offset(1, 0)
Loop
End Sub
The formula in one column should be =IFERROR(IF(VLOOKUP(D2,DataDrop!A:C,3,FALSE)<>"NULL","Charged Off","Active ")," Active")
And the other column should be =IFERROR(VLOOKUP(D2,DataDrop!A:C,2,FALSE),0)
No need for a loop, just get the last row based on Column D, and write the formulas to the entire range in question in one go. Also, quotation marks within formulas need to be doubled up.
Sub COAB()
With ThisWorkbook.Sheets("MasterData")
Dim lastRow As Long
lastRow = .Cells(.Rows.Count, "D").End(xlUp).Row
.Range(.Range("W2"), .Range("W" & lastRow)).Formula = _
"=IFERROR(IF(VLOOKUP(D2,DataDrop!A:C,3,FALSE)<>""NULL"",""Charged Off"",""Active ""),"" Active"")"
.Range(.Range("X2"), .Range("X" & lastRow)).Formula = _
"=IFERROR(VLOOKUP(D2,DataDrop!A:C,2,FALSE),0)"
End With
End Sub
The aim is to calculate the average and write it into a cell. The code for it is as following:
Sub Schaltfläche2_Klicken() Dim wb As Workbook, wq As Object
Dim ws As Worksheet, datdatum
Set wb = Workbooks.Add
Set ws = wb.Worksheets("Tabelle1")
ws.Range("D84").Formula = "=Average(D19,D29,D35,D46)
ws.Range("E84").Formula = "=Average(E19,E29,E35,E46)
ws.Range("F84").Formula = "=Average(F19,F29,F35,F46)
The short way is:
ws.Range("D84:P84").Formula = "=Average(D19,D29,D35,D46)
And that works for the specified range.
No need for a loop. VBA will make the change on it's own:
s.Range("D84:P84").Formula = "=Average(D19,D29,D35,D46)"
Excel will change the column reference as if it were dragged across.
But if you really want to loop then you need to remove the vba from the quotes in the string and concatenate with &
For i = 4 To 16
ws.Cells(84, i).Formula = "=Average(" & ws.Cells(19,i).Address & "," & _
ws.Cells(29,i).Address & "," &ws.Cells(35,i).Address & "," & _
ws.Cells(46,i).Address)"
Next i
I'm wondering how to make the following code work for multiple columns (D:P)? I've already tried adding & ":"P" & "65536" to the range, without success.
For i = 5 To Range("D" & "65536").End(xlUp).Row Step 1
If Application.WorksheetFunction.CountIf(Range("D" & i), "0") = 1 Then
Range("D" & i).ClearContents
End If
Next i
You can use Range("D5:P65536").Replace What:=0,Replacement:="" to Replace all at once.
Loop through the actual column and use the Find() method to perform your search. If your value exists in that range (range = column), then you can clear the contents that way.
Sub test()
' Just for illustration on the columns
Const D& = 4: Const P& = 16
Dim ws As Worksheet, col As Long
Set ws = ThisWorkbook.Worksheets(1)
For col = D To P
If Not ws.Columns(col).find(What:="0", LookAt:=xlWhole) Is Nothing Then
ws.Columns(col).ClearContents
End If
Next col
End Sub
So I have a VBA that is suppose to copy the on the "data" sheet and paste it on the "Internal Use" via searching a cell on cell in the "Internal Use" I'm not getting an error it is just not doing it and it after I run the macro it just stays on the "data" sheet.
What am I missing?
Sub CommandButton2_Click()
Worksheets("Internal Use").Activate
project = Range("C4")
Worksheets("data").Activate
nr = Range("A" & Rows.Count).End(xlUp).Row
For Row = 2 To nr
If Range("F" & Row) = Worksheets("Internal Use").Range("C4") Then
Range("Q" & Row) = Worksheets("Internal Use").Range("C7")
End If
Next Row
End Sub
Hard to tell what you're trying to do. Let me know if this is what you want.
Sub CommandButton2_Click()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim nr As Long
Dim project As Variant
Set ws1 = ThisWorkbook.WorkSheets("Internal Use")
Set ws2 = ThisWorkbook.WorkSheets("data")
project = ws1.Range("C4").Value2
With ws1
nr = .Range("A" & .Rows.Count).End(xlUp).Row
For r = 2 To nr
If .Range("F" & r) = project Then
ws2.Range("Q" & r) = .Range("C7")
End If
Next
End With
End Sub
Ricardo,
Your code is working fine. Question is what are you trying to accomplish? If you are trying to paste on 'Internal Use' sheet, you need to activate it. I have added a line to activate it. Please be more specific on what you want to accomplish.
Sub CommandButton2_Click()
Worksheets("Internal Use").Activate
project = Range("C4")
Worksheets("data").Activate
nr = Range("A" & Rows.Count).End(xlUp).Row
Worksheets("Internal Use").Activate
For Row = 2 To nr
If Range("F" & Row) = Worksheets("Internal Use").Range("C4") Then
Range("Q" & Row) = Worksheets("Internal Use").Range("C7")
End If
Next Row
End Sub
You want to populate column Q on the data sheet with the value from Worksheet Internal Use cell C7, whenever column F on the same row is equal to cell C4.
I have to say that that's easily solvable with a formula using index match or a conditional formula like =If(F2='Internal Use'!$C$4,'Internal Use'!$C$7,"") (Just paste in column F). At least this is what your code currently more or less does or seems to want to achieve.
That said let's take a look at your code:
First of all avoid .Activate, it's unnecessary overhead. This will activate the worksheet. (By the way, the last .activate you use, is on the data worksheet, hence it stays there) Next you store C4 in an undeclared variable called project that you never use.
Next you reference the cells everywhere in the loop again. This means there is huge overhead on accessing and reading out these cells. Lastly you do this in a loop; I assume this is to avoid filling up any of the other rows.
To make your code work, you could use:
Sub CommandButton2_Click()
Dim project as string
Dim writeValue as string
Dim lr as long
Dim wr as long
project = Worksheets("Internal Use").Range("C4").value
writeValue = Worksheets("data").Range("C7").value
lr = Range("A" & Rows.Count).End(xlUp).Row
With Worksheets("data")
For wr = 2 To lr
If .Range("F" & wr).value = project Then
.Range("Q" & rw).value = writeValue
End If
Next wr
End With
End Sub
This will do the trick.
Neater would be to avoid the for loop and testing all cells. Two options are putting the entire F and Q columns into arrays and loop through those simultaniously while altering the Q-array before dumping the values back in the sheet, or use a Find-algorithm such as Chip Pearons FindAll: http://www.cpearson.com/excel/findall.aspx