For each or Named Range to populate ListBox - vba

All I am trying to populate a listbox with a For Each loop which iterates through the rows. The for each loop is going through the items in a Named range (ProgramIDs).
The current code I am using is
If Len(ProjectInformation.Range("H2").Value) = 7 Then
Dim Lr As Long
Lr = Range("H1048576").End(xlUp).Row
For Each C In Range("H2:H" & Lr)
With Program_ListBox
.AddItem C.Value
End With
Next C
End If
I fear this is a very basic question however after researching the website / google I simply cannot get this simple task to function.
Any help would be appreciated.

There is no need to loop, you can pass the range as the source of the listbox
Program_ListBox.List = Range("H2:H" & Lr)

Range("H2:H" & Lr) references the cells on the ActiveSheet. You should always fully qualify your references.
With ProjectInformation
If Len(.Range("H2").Value) = 7 Then
For Each C In .Range("H2", .Range("H" & .Rows.Count).End(xlUp))
With Program_ListBox
.AddItem C.Value
End With
Next C
End If
End With
There is no need loop the cells to the add the values to the listbox. You can assign the Range().Value array directly to the Listbox.List array.
With ProjectInformation
If Len(.Range("H2").Value) = 7 Then
Program_ListBox.List = .Range("H2", .Range("H" & .Rows.Count).End(xlUp)).Value
End If
End With

Related

Comparing Two Major Workbooks By Two Columns and many Params

I'm writing a code to compare two rows in two different workbooks that can be located at different places among the column. The first column is usually grouped (multiple of the same value) in one section. This is why In this code I search by the first column, then pick the other identifier column and offset one at a time while both workbook sheets match each other
I am trying to activate the cell that I find via the .Find function in this code, but apparently you can't do that. "Active method of range class failed"
I believe that I am on the right track with this code, but I'm sure there are still issues, I'm trying to solve one problem at a time with my limited skills!
Thanks for the help :)
Sub Compare2()
Dim layer As String
Dim Pno As String
Dim firstAddress As String
Dim i As Long
Dim c As Range
Option Explicit
For i = 5 To 1000 Step 1
layer = Sheets("MP Parameters").Range("A" & i).Value
Pno = Sheets("MP Parameters").Range("H" & i).Value
With Sheets("Compare").Range("a1:a1500")
Set c = .Find(layer, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
c.Activate
Do
Sheets("Compare").ActiveCell.Offset(rowOffset:=0, columnOffset:=7).Activate
If Sheets("Compare").ActiveCell = Pno Then
Sheets("Compare").ActiveCell.Offset(rowOffset:=0, columnOffset:=9).Activate
If Sheets("Compare").ActiveCell.Value <> Sheets("MP Parameters").Range("P" & i).Value Then
Sheets("MP Parameters").Range("P" & i).Interior.ColorIndex = 46
End If
End If
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
i = i + 1
End If
End With
Next i
End Sub
You can only Activate a cell if it's on the ActiveSheet. Since your code references then Activates cells on different sheets, you will cause errors.
You have two options.
Either activate the appropriate sheet first:
Sheet1.Activate
Range("A2").Activate
Or, don't activate a sheet to do a conditional check. You don't have to activate a cell to determine what it's value is. As an example, if you wanted to check what value is in sheet1, cell B2 (irrespective of which sheet is active in the workbook):
If Sheet1.Range("B2").Value = "Yes" ...
The code within your If Not c Is Nothing ... End If block can be changed to:
firstAddress = c.Address
Do
If c.Offset(0, 7).Value = Pno Then
If c.Offset(0, 16).Value <> Sheets("MP Parameters").Range("P" & i).Value Then
Sheets("MP Parameters").Range("P" & i).Interior.ColorIndex = 46
End If
End If
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
i = i + 1
(I'm not sure what the i = i + 1 is meant to be doing. I've always found it dangerous to modify the loop counter manually. But I left it there as hopefully it is doing what you want it to do.)

LOOP: Copy Cells Value (in a list) from one Sheet to Another

The purpose of this macro is copy one cell value (from a long list) to another cell located in a different sheet.
here's my code:
Sub journalben()
Set rawben = Sheets("BEN")
Set finaljnl = Sheets("JNL_BEN")
Set Rng = Range("G2:G1048576")
For Each cell In Rng
'test if cell is empty
If cell.Value <> "" Then
finaljnl.Range("L4").Value = rawben.Range("G5").Value
finaljnl.Range("K4").Value = rawben.Range("L5").Value
End If
Next
End Sub
With the help of the image, I will explain what I'm trying to achieve:
From Sheet1 ("BEN") there's a list sitting in columns G and L.
I will copy the cell G5 from Sheet1 and paste it in Sheet2 ("JNL_BEN") Range K4.
Next is I will copy the cell L5 from Sheet1 and paste it in Sheet2 ("JNL_BEN") Range L4.
Copy the next in line and do the same process just like No.2 and 3 but this time, it will adjust 1 row below.
Copy the whole list. That means up to the bottom. The list is dynamic, sometimes it will go for 5,000 rows.
For some reasons, copying the entire column is not an option to this macro due to requirement that cells from sheet1 MUST be pasted or placed in Sheet2 from left to right (or horizontally).
I hope you could spare some time to help me. My code didn't work, I guess the implementation of FOR EACH is not correct. I'm not sure if FOR EACH is the best code to use.
I appreciate anyone's help on this. Thank you very much! May the force be with you.
Try this:
Sub journalben()
Dim i As Long, lastRow As Long
Set rawben = Sheets("BEN")
Set finaljnl = Sheets("JNL_BEN")
lastRow = rawben.Cells(Rows.Count, "G").End(xlUp).Row
For i = 5 To lastRow
'test if cell is empty
If rawben.Range("G" & i).Value <> "" Then
finaljnl.Range("K" & i - 1).Value = rawben.Range("G" & i).Value
finaljnl.Range("L" & i - 1).Value = rawben.Range("L" & i).Value
End If
Next i
End Sub
I am starting FOR from 5 as the data in your image starts from cell G5 (not considering the header).
It'll be easier to use a numeric variable for this :
Sub journalben()
Set rawben = Sheets("BEN")
Set finaljnl = Sheets("JNL_BEN")
Set Rng = rawben.Range("G4:G1048576")
For i = Rng.Cells(1,1).Row to Rng.Cells(1,1).End(xlDown).Row
'test if cell is empty
If rawben.Range("G" & i).Value <> vbNullString Then
finaljnl.Range("L" & i - 1).Value = rawben.Range("G" & i).Value
finaljnl.Range("K" & i - 1).Value = rawben.Range("L" & i).Value
End If
Next i
End Sub
You should use a simple for loop. It is easier to work with.
Also, to have it dynamic and to go to the last cell in the range, use the SpecialCells method.
And your range needs to be set correctly from row 5.
Here is the code:
Sub journalben()
Set rawben = Sheets("BEN")
Set finaljnl = Sheets("JNL_BEN")
Set Rng = Range("G5:G1048576")
For i = Rng.Cells(1,1).Row to Rng.SpecialCells(xlCellTypeLastCell).Row
If rawben.Range("G" & i).Value <> vbNullString Then
finaljnl.Range("L" & CStr(i - 1)).Value = rawben.Range("G" & CStr(i)).Value
finaljnl.Range("K" & CStr(i - 1)).Value = rawben.Range("L" & CStr(i)).Value
End If
Next i
End Sub

Copy cell C value to other sheet if Cell A = Cell B

I am new to vb macro, what I want to do is if cell A (list) = cell b then copy the value of cell C to another sheet, once copied, if the list changes to another name, the value of cell C should be empty, but the previously copied value from cell C should be retained.
I have this code but it seems it doesn't run.
Sub SearchMacro()
Dim LR As Long, i As Long
With Sheets("M-List")
LR = .Range("T" & Rows.Count).End(xlUp).Row
For i = 1 To LR
With .Range("T" & i)
If .Value = "JAN!D158=N2" Then
Sheets("JAN!").Range("D158:H158").Copy Destination:=Sheets("M-List!").Range("T2")
End If
End With
Next i
End With
End Sub
Your question seems confusing from the beginning. If you want to compare two cells you do
Sheets("Sheet1").Range("A1").Value = Sheets("Sheet1").Range("B50").Value
Your code seems a little bit odd with what you said you want to do, but here are some recommendations so you can play with it
Try .Formula instead of .Value = "JAN!D158=N2", If .Formula = "JAN!D158=N2" Then
Try Sheets("JAN") instead of "JAN!"
You may want to use .Value instead of .Copy
Sheets("M-List").Range("T2").Value = Sheets("JAN!").Range("D158:H158").Value
You may want to use variables for the row numbers D158 or T2 like .Range("T" & var_row)

Excel-Macro to fill serial numbers to filtered data

I have 3 columns A,B & C. The data is in B & C. I filter Column C to show "Unique records only". Now I want to add serial numbers to this filtered data in Column A. Be advised that the number of rows in the list (and therefore the filtered list) is not fixed.
I know the function (=SUBTOTAL(3,$B$1:B2)-1 ) but this requires manual intervention. I also found the VBA code that works on an unfiltered list:
Sub FillSerialNumbers()
With Range("A3:A" & Range("B" & Rows.Count).End(xlUp).Row)
.Cells(1, 1).Value = 1
.DataSeries Rowcol:=xlColumns, Type:=xlLinear, Step:=1, Trend:=False
End With
End Sub
However I'm unable to implement it on a filtered list. Any help would be appreciated.
Here is another way
Set rRng = Range("A3:A" & Range("B" & Rows.Count).End(xlUp).Row)
Dim cntr As Integer: cntr = 1
For Each cell In rRng
If cell.EntireRow.Hidden = False Then
Cells(cell.Row, 1).Value = cntr
cntr = cntr + 1
End If
Next
As a formula solution, you could try, in cell A3 and copied down:
=IF(AND(COUNTIF(C$3:C3,C3)=1,C3<>""),max(A$2:A2)+1,"")

How can I access a Range inside a filtered list to retrieve the values? VBA

I'm trying to access the values in C(Number):D(Number) inside the filtered list, however I seem to be doing something wrong because the MsgBox never shows up.
'Filter only numeric values
With MaterialListSheet
.AutoFilterMode = False
.Range("B1").AutoFilter Field:=1, Criteria1:="0*"
End With
Set rangeInventory = InventorySheet.Range("N1:N" & Rows.Count)
' I had Set rangeMaterialList = MaterialListSheet.Range("B1:B" & Rows.Count) in the beginning but I realized If I need C and D i'm only selecting B
Set rangeMaterialList = MaterialListSheet.Range("B1:F" & Rows.Count)
For Each CellML In rangeMaterialList.SpecialCells(xlCellTypeVisible)
BomCodesToSplit = CellML.Range("C" & Rows.Row & ":D" & Rows.Row).Values
MsgBox BomCodesToSplit
For Each CellI In rangeInventory.SpecialCells(xlCellTypeVisible)
Next CellI
Next CellML
Tried this but no luck:
BomCodesToSplit = MaterialListSheet.Range("C" & Rows.Row & ":D" & Rows.Row).Values
I'd like to select
C1:D1
C2:D2
C3:D3
.
.
.
Meaning something like this so it selects it depending on the loop index
Cn:Dn
In some other programming languages I would use the index of the loop but since I'm new to VBA I have no idea how to do this.
How to achieve this?
Not entirely sure what you are doing but you can use the iterating variable property.
In for each loops iterating over some range it's best to use the Range type variable to get the intellisense
example
Dim cell as Range
for each cell in Range("A1:A10")
debug.? cell.Value, cell.Address, cell.Row, cell.Column
next
Note: as you type the cell. you get an intellisense which only lists the properties that are currently available to the object you are working with.