VBA For each cell in - vba

I have a sheet with data in columns A to H. Some cells in column A and B have no values or are empty, but there are values in that rows other columns that is C to H. Now I have this code to do this. loop through each empty cell in B and put in the values. that is my code will fill down till the last non empty cell in B. but I get an error.
Sub filldownemptyAB()
Dim cel As Range, rng As Long
rng = Cells(Rows.Count, 1).End(xlUp).row
For Each cel In rng.Cells
With ActiveCell
.Offset(, 0).Formula = "=year(today())"
.Offset(, -1).Value = "Actual"
End With
Next cel
End Sub
the error is at this line
For each cel in rng

I believe you're looking for this:
(I edited a few times to simplify things a bit and to scan column B instead of column A)
Sub FillDownEmptyAB()
Dim c, lr
lr = ActiveSheet.UsedRange.Rows.CountLarge
For Each c In Range("B1:B" & lr)
If c.Value = "" Then
c.Offset(,-1).Value = "Actual"
c.Formula = "=YEAR(TODAY())"
End If
Next c
End Sub
Input:
Output:

A Long is not a collection of Ranges.
I think you are trying to do something like this:
Sub filldownemptyAB()
Dim cel As Range
Dim lastRow As Long
lastRow = Cells(Rows.Count, 1).End(xlUp).row
Dim rng as Range
Set rng = Range("B" & lastRow)
For Each cel In rng
With cel
.Offset(, 0).Formula = "=year(today())"
.Offset(, -1).Value = "Actual"
End With
Next cel
End Sub
But it's hard to tell.

Related

Macro to copy-paste range in row to different sheets based on specific cell value

I have a workbook with 3 sheets: first one is the raw data sheet, then 2 target sheets. I would need a macro that would look at cell C in raw data sheet and based on the 2 values (YES or NO), will copy and paste the range A:Y in sheets 2, respectively 3.
Example: if on C2 in raw data sheet i have YES, copy A2:Y2 and paste into sheet 2, same range A2:Y2. If instead i have the value NO, copy A2:Y2 and paste into sheet 3.
Then go to next row and copy-paste A3:Y3 to sheet 2 if YES or A3:Y3 to sheet 3 if NO.
I wrote something that only works for the 2nd row, but i don't know how to make it loop... so basically when it passes to the next rows, it still copies the values from A2:Y2 to the target sheet, instead of copying A3:Y3, A4:Y4 etc..
Pasting my poor code below:
Sub IdentifyInfraction()
Dim rngA As Range
Dim cell As Range
Set rngA = Range("C2", Range("C65536").End(xlUp))
For Each cell In rngA
Worksheets("raw_data").Select
If cell.Value = "YES" Then
Range("A2:Y2").Copy
Worksheets("Value_YES").Select
Range("A2").PasteSpecial Paste:=xlPasteValues
ElseIf cell.Value = "NO" Then
Range("A2:Y2").Copy
Worksheets("Value_NO").Select
Range("A2").PasteSpecial Paste:=xlPasteValues
End If
Next cell
End Sub
Please help!!! :-s
Easiest solution would just be to replace the number 2 in each of your ranges to a variable which you then increment at the end your statement, before you go to the next cell.
For example:
Dim i = 2
Set rngA = Range("C2", Range("C65536").End(xlUp))
For Each cell In rngA
Worksheets("raw_data").Select
If cell.Value = "YES" Then
Range("A" & i & ":Y" & i).Copy
Worksheets("Value_YES").Select
Range("A" & i).PasteSpecial Paste:=xlPasteValues
ElseIf cell.Value = "NO" Then
Range("A" & i & ":Y" & i).Copy
Worksheets("Value_NO").Select
Range("A" & i).PasteSpecial Paste:=xlPasteValues
End If
i = i + 1
Next cell
So, originally we set i = 2, this is to go in line with your starting row of 2 mentioned in your question. Then, Range("A" & i & ":Y" & i).Copy is the same as saying Range("A2:Y2").Copy or Range("A3:Y3").Copy, etc.
This will go through any copy each row, a new row each time, and paste it to the respective row in the various sheets.
I hope this works for what you are trying to do, if not let me know.
There are a few things I'd also recommend looking into. There's a much better way to copy and paste, without going back and forward through the sheets.
ThisWorkbook.Sheets("raw_data").Rows(i).Copy Destination:=Worksheets("Value_YES").Range("A" & i)
Something like this would take the whole row from raw_data and transfer it to Value_YES. You'd have to mess around with it and change the range from Rows(i), but that's just an example.
I'd also recommend that you look into How to avoid using Select in Excel VBA to better understand why it's frowned upon to use Select and Activate in Excel VBA.
My version:
Sub GetR_Done()
Dim rng As Range, c As Range, LstRw As Long
Dim ws As Worksheet, Nr As Long, Yr As Long
Dim Ys As Worksheet, Ns As Worksheet
Set ws = Sheets("raw_data")
Set Ys = Sheets("Value_YES")
Set Ns = Sheets("Value_NO")
With ws
LstRw = .Cells(.Rows.Count, "C").End(xlUp).Row
Set rng = .Range("C2:C" & LstRw)
For Each c In rng.Cells
If c = "YES" Then
With Ys
Yr = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
End With
.Range(.Cells(c.Row, "A"), .Cells(c.Row, "Y")).Copy Ys.Range("A" & Yr)
End If
If c = "NO" Then
With Ns
Nr = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
End With
.Range(.Cells(c.Row, "A"), .Cells(c.Row, "Y")).Copy Ns.Range("A" & Nr)
End If
Next c
End With
End Sub
If you really require to paste values, then use this one
Sub GetR_Done()
Dim rng As Range, c As Range, LstRw As Long
Dim ws As Worksheet, Nr As Long, Yr As Long
Dim Ys As Worksheet, Ns As Worksheet
Set ws = Sheets("raw_data")
Set Ys = Sheets("Value_YES")
Set Ns = Sheets("Value_NO")
Application.ScreenUpdating = False
With ws
LstRw = .Cells(.Rows.Count, "C").End(xlUp).Row
Set rng = .Range("C2:C" & LstRw)
For Each c In rng.Cells
If c = "YES" Then
With Ys
Yr = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
End With
.Range(.Cells(c.Row, "A"), .Cells(c.Row, "Y")).Copy
Ys.Range("A" & Yr).PasteSpecial xlPasteValues
End If
If c = "NO" Then
With Ns
Nr = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
End With
.Range(.Cells(c.Row, "A"), .Cells(c.Row, "Y")).Copy
Ns.Range("A" & Nr).PasteSpecial xlPasteValues
End If
Next c
End With
Application.CutCopyMode = False
End Sub
you could try this:
Sub IdentifyInfraction()
Dim cell As Range
With Worksheets("raw_data") 'reference "raw data" sheet
For Each cell In .Range("C2", .cells(.Rows.Count, "C").End(xlUp)) ' loop through referenced sheet column C cells from row 2 down to last not empty one
Worksheets("Value_" & cell.Value).Range(cell.Address).Resize(, 25).Value = cell.Resize(, 25).Value 'have proper target sheet A:Y current cell row values as "raw data" sheet ones
Next
End With
End Sub

Insert HLOOKUP formula if cell contains text

This is how my spreadsheet looks like:
enter image description here
I would like to insert a HLOOKUP formula to the cell immediate right of 58DV if the cell contains 58DV. If there is no data, nothing needs to be done. I'm still quite new to VBA so I'm not sure how can i work with formulas in VBA. Thanks
Sub sitelookup()
With Application
.ScreenUpdating = False
End With
Dim SrchRng As Range, cel As Range
Set SrchRng = Range("C4:C1299")
For Each cel In SrchRng
If cel > 0 Then
cel.Offset(0,1).value = Application.WorksheetFunction.HLOOKUP(F4,'Raw G'!2:5,2,0)
End If
Next cel
End Sub
Try,
with worksheets("sheet1")
Set SrchRng = .Range(.cells(4, "B"), .cells(rows.count, "B").end(xlup))
For Each cel In SrchRng
If cel.value2 = "58DV" Then
'to put the formula's value into the neighboring cell
cel.Offset(0, 1).value = _
Application.HLOOKUP(.cells(cel.row, "F"), worksheets("Raw G").range("2:5"), 2, 0)
'to put the formula into the neighboring cell
'cel.Offset(0, 1).formula = _
"=HLOOKUP(F" & cel.row & ",'Raw G'!2:5, 2, 0)"
End If
Next cel
end with

Selecting a range from a specific cell and then special paste that range using VBA

i have an excel file in which i have data month wise, so i want to select Column F, G and H from the active cell till the last data of that column and then special paste it.
I am using this Code for selecting that range but not able to do that. it is selecting the data from the F1.
Sub selecting_range()
Dim rng As Range
Dim LastRow As Long
currentcell = ActiveCell
LastRow = Cells(Rows.Count, "F" & currentcell).End(xlUp).Row
Set rng = Range("F1:H" & LastRow)
rng.Select
End Sub
Considering the fact that the "F" and "H" are hardcoded, then you can build up something like this:
Sub SelectingRange()
Dim rng As Range
Dim lastRow As Long
lastRow = Cells(Rows.Count, "F").End(xlUp).Row
Set rng = Range(Cells(ActiveCell.Row, "F"), Cells(lastRow, "H"))
rng.Select
End Sub
Or you can write it in 1-line, just to confuse someone:
Sub SelectingRange()
Range(Cells(ActiveCell.Row, "F"), Cells(Cells(Rows.Count, "F").End(xlUp).Row, "H")).Select
End Sub

Making "Countif" worksheet function variable

I have a code that counts the cell in a range if there's a number. The total number of cell counted will then be shown in row 3. My issue now is that the formula is not variable and I have no idea how to make it too.
If I enter this code, row 3 reports all the same result (which is from the first column of data). Hoping somebody can help me here!!
Sub Six_Continue()
Dim Rng As Range
Dim LastClm As Long
With ActiveSheet
LastClm = .Cells(1, .Columns.Count).End(xlToLeft).Column
Set Rng = Range(.Cells(3, 3), .Cells(3, LastClm))
Rng.Value = Application.WorksheetFunction.CountIf(Range("C5", "C" & Cells(Rows.Count, 5).End(xlUp).Row), "<>?")
End With
End Sub
Your CountIf will count cells even if they don't contain a number. Using Count ensures that only cells containing numbers are taken into account.
Sub Six_Continue()
Dim Rng As Range
Dim LastClm As Long
Dim myClm As Long
With ActiveSheet
LastClm = .Cells(1, .Columns.Count).End(xlToLeft).Column
For myClm = 1 To LastClm
Set Rng = .Cells(3, myClm)
Rng.Value = Application.WorksheetFunction.Count(Range(.Cells(5, myClm), .Cells(.Cells(Rows.Count, myClm).End(xlUp).Row, myClm)))
Next myClm
End With
End Sub
Try this modified version:
Sub Six_Continue()
Dim Rng As Range
Dim LastClm As Long, i As Long
LastClm = Cells(1, Columns.Count).End(xlToLeft).Column
For i = 1 To LastClm
Cells(3, i).Value = Application.WorksheetFunction.CountIf(Range(Cells(1, i), Cells(2, i)), "<>?")
Next
End Sub

Concatenate Cell Values Dynamically And Copy Result to Another Worksheet

I have a worksheet ("Data") with x-columns and y-rows. I want to concatenate the values of a row and the concatenated result should be copied to a second worksheet ("Insert") in the first column of the same row.
I tried this VBA and get an error message
Sub InsertStatementRow()
Dim x As String, rng As Range, rng1 As Range, cel As Range
Dim ColMax As Integer
Dim i As Long
Sheets("Data").Select
Range("A1").Select
ColMax = Cells(1, Columns.Count).End(xlToLeft).Column
With Worksheets("Data")
i = 1
Set rng = Range(Cells(i, 1), Cells(i, ColMax))
End With
For Each cel In rng
x = x & cel.Value
Next
Range(Sheets("Insert").Cells(i, 1)).Value = x
End Sub
Please show me what I am doing wrong by correcting my code. Thanks!
Use some "." :
Set rng = Range(.Cells(i, 1), .Cells(i, ColMax))