I am trying to populate a listbox from a list of items, I can get it to populate but it is taking in my header row as a row in the list and the headers are blank. I am not sure where I am going wrong. Any help would be great.
Sub populateList()
Dim rngName As Range
Dim ws As Worksheet
Dim i As Integer
Set ws = Worksheets("ProjectData")
lbTasks.Clear
lbTasks.ColumnHeads = True
lbTasks.ColumnCount = 10
Dim LastRow As Long
LastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
For i = 1 To LastRow
If ws.Cells(i, 1).Value <> vbNullString Then lbTasks.AddItem ws.Cells(i, 1).Value
If ws.Cells(i, 2).Value <> vbNullString Then lbTasks.List(i - 1, 1) = ws.Cells(i, 2).Value
If ws.Cells(i, 3).Value <> vbNullString Then lbTasks.List(i - 1, 2) = ws.Cells(i, 3).Value
If ws.Cells(i, 4).Value <> vbNullString Then lbTasks.List(i - 1, 3) = ws.Cells(i, 4).Value
If ws.Cells(i, 5).Value <> vbNullString Then lbTasks.List(i - 1, 4) = ws.Cells(i, 5).Value
If ws.Cells(i, 6).Value <> vbNullString Then lbTasks.List(i - 1, 5) = ws.Cells(i, 6).Value
If ws.Cells(i, 7).Value <> vbNullString Then lbTasks.List(i - 1, 6) = ws.Cells(i, 7).Value
If ws.Cells(i, 8).Value <> vbNullString Then lbTasks.List(i - 1, 7) = ws.Cells(i, 8).Value
If ws.Cells(i, 9).Value <> vbNullString Then lbTasks.List(i - 1, 8) = ws.Cells(i, 9).Value
If ws.Cells(i, 10).Value <> vbNullString Then lbTasks.List(i - 1, 9) = ws.Cells(i, 10).Value
Next i
End Sub
Related
I have 2 sheets, sourcesheet and acct sheet. From sourceSheet I need to copy the values from sourceSheet.Range(Cells(14, 3),Cells(14, 8)) to AcctSheet.range(Cells(2, 11),Cells(7, 11)), however each cell from sourcesheet is distinct matched to acctsheet, in such a way that
sourceSheet.Cells(14, 3) = AcctSheet.Cells(2, 11)
sourceSheet.Cells(14, 4) = AcctSheet.Cells(3, 11)
sourceSheet.Cells(14, 5) = AcctSheet.Cells(4, 11) and so on until
sourceSheet.Cells(14, 8) = AcctSheet.Cells(7, 11)
Code is here, but hoping to loop this one.
sourceSheet.Activate
'EQ
If IsEmpty(sourceSheet.Cells(14, 3).Value) Then
AcctSheet.Cells(2, 11).Value = sourceSheet.Cells(7, 1).Value
ElseIf sourceSheet.Cells(14, 3).Value < sourceSheet.Cells(7, 1).Value Then
AcctSheet.Cells(2, 11).Value = sourceSheet.Cells(14, 3).Value
ElseIf sourceSheet.Cells(14, 3).Value > sourceSheet.Cells(7, 1).Value Then
AcctSheet.Cells(2, 11).Value = sourceSheet.Cells(7, 1).Value
End If
'WS
If IsEmpty(sourceSheet.Cells(14, 4).Value) Then
AcctSheet.Cells(3, 11).Value = sourceSheet.Cells(7, 1).Value
ElseIf sourceSheet.Cells(14, 4).Value < sourceSheet.Cells(7, 1).Value Then
AcctSheet.Cells(3, 11).Value = sourceSheet.Cells(14, 4).Value
ElseIf sourceSheet.Cells(14, 4).Value > sourceSheet.Cells(7, 1).Value Then
AcctSheet.Cells(3, 11).Value = sourceSheet.Cells(7, 1).Value
End If
'TO
If IsEmpty(sourceSheet.Cells(14, 5).Value) Then
AcctSheet.Cells(4, 11).Value = sourceSheet.Cells(7, 1).Value
ElseIf sourceSheet.Cells(14, 5).Value < sourceSheet.Cells(7, 1).Value Then
AcctSheet.Cells(4, 11).Value = sourceSheet.Cells(14, 5).Value
ElseIf sourceSheet.Cells(14, 5).Value > sourceSheet.Cells(7, 1).Value Then
AcctSheet.Cells(4, 11).Value = sourceSheet.Cells(7, 1).Value
End If
'FL
If IsEmpty(sourceSheet.Cells(14, 6).Value) Then
AcctSheet.Cells(5, 11).Value = sourceSheet.Cells(7, 1).Value
ElseIf sourceSheet.Cells(14, 6).Value < sourceSheet.Cells(7, 1).Value Then
AcctSheet.Cells(5, 11).Value = sourceSheet.Cells(14, 6).Value
ElseIf sourceSheet.Cells(14, 6).Value > sourceSheet.Cells(7, 1).Value Then
AcctSheet.Cells(5, 11).Value = sourceSheet.Cells(7, 1).Value
End If
'FR
If IsEmpty(sourceSheet.Cells(14, 7).Value) Then
AcctSheet.Cells(6, 11).Value = sourceSheet.Cells(7, 1).Value
ElseIf sourceSheet.Cells(14, 7).Value < sourceSheet.Cells(7, 1).Value Then
AcctSheet.Cells(6, 11).Value = sourceSheet.Cells(14, 7).Value
ElseIf sourceSheet.Cells(14, 7).Value > sourceSheet.Cells(7, 1).Value Then
AcctSheet.Cells(6, 11).Value = sourceSheet.Cells(7, 1).Value
End If
'TR
If IsEmpty(sourceSheet.Cells(14, 8).Value) Then
AcctSheet.Cells(7, 11).Value = sourceSheet.Cells(7, 1).Value
ElseIf sourceSheet.Cells(14, 8).Value < sourceSheet.Cells(7, 1).Value Then
AcctSheet.Cells(7, 11).Value = sourceSheet.Cells(14, 8).Value
ElseIf sourceSheet.Cells(14, 8).Value > sourceSheet.Cells(7, 1).Value Then
AcctSheet.Cells(7, 11).Value = sourceSheet.Cells(7, 1).Value
End If
Is something like this what you are looking for?
Option Explicit
Sub test()
Dim sourceSheet As Worksheet, acctSheet As Worksheet
Dim i As Long
Dim sourceCell As Range, targetCell As Range, defaultCell As Range
Set defaultCell = sourceSheet.Cells(7, 1)
For i = 3 To 8
Set sourceCell = sourceSheet.Cells(14, i)
Set targetCell = acctSheet.Cells(i - 1, 11)
If IsEmpty(sourceCell) Then
targetCell.Value2 = sourceCell.Value2
ElseIf sourceCell.Value2 < defaultCell.Value2 Then
targetCell.Value2 = sourceCell.Value2
ElseIf sourceCell.Value2 > defaultCell.Value2 Then
targetCell.Value2 = defaultCell.Value2
End If
Next i
End Sub
Strictly speaking, I don't think you need to include .Value2 after every cell, as VBA kinda uses that as the default when reading the code, but it doesn't hurt.
Using variables for the cell references isn't strictly necessary either, but I find it easier, especially if I need to edit the cell references later.
Pic 2 shows what the solution should be and Pic 1 shows what my code has given me, the differences occur in the "Yearly Change","Percent Change" and "Total Stock Volume" columns.
The loop I created works for all the sheets but my figures in those specified column are off, can I get help in rectifying my code attached to get numbers similar to Pic 2? Thank you
Option Explicit
Sub Stockmarket()
'Declare and set worksheet
Dim ws As Worksheet
'Loop through all stocks for one year
For Each ws In Worksheets
'Create the column headings
ws.Range("I1").Value = "Ticker"
ws.Range("J1").Value = "Yearly Change"
ws.Range("K1").Value = "Percent Change"
ws.Range("L1").Value = "Total Stock Volume"
ws.Range("P1").Value = "Ticker"
ws.Range("Q1").Value = "Value"
ws.Range("O2").Value = "Greatest % Increase"
ws.Range("O3").Value = "Greatest % Decrease"
ws.Range("O4").Value = "Greatest Total Volume"
'Define Ticker variable
Dim Ticker As String
'Set initial and last row for worksheet
Dim Lastrow As Long
Dim i As Long
Dim j As Integer
Dim x As Double
j = 2
x = 2
'Define Lastrow of worksheet
Lastrow = ws.Cells(Rows.Count, 1).End(xlUp).Row
'Set new variables for prices and percent changes
Dim open_price As Double
'open_price = 0
Dim close_price As Double
'close_price = 0
Dim price_change As Double
'price_change = 0
Dim price_change_percent As Double
'price_change_percent = 0
'Create variable to keep the ticker row in
Dim TickerRow As Long
TickerRow = 1
Dim stock_volume As Double
stock_volume = 0
'Do loop of current worksheet to Lastrow
For i = 2 To Lastrow
'Ticker symbol output
If ws.Cells(i + 1, 1).Value <> ws.Cells(i, 1).Value Then
TickerRow = TickerRow + 1
Ticker = ws.Cells(i, 1).Value
ws.Cells(TickerRow, "I").Value = Ticker
'Stock Volume output
If ws.Cells(i, 1).Value = ws.Cells(i + 1, 1).Value Then
stock_volume = stock_volume + ws.Cells(i, 7).Value
ElseIf ws.Cells(i, 1).Value <> Cells(i + 1, 1).Value Then
stock_volume = stock_volume + ws.Cells(i, 7).Value
ws.Cells(j, 9).Value = ws.Cells(i, 1).Value
ws.Cells(j, 12).Value = stock_volume
j = j + 1
stock_volume = 0
End If
'Creating the Yearly change and Percent change output
open_price = ws.Cells(i, 3).Value
close_price = ws.Cells(i, 6).Value
ws.Cells(x, 10).Value = open_price - close_price
If close_price <= 0 Then
ws.Cells(x, 11).Value = 0
Else
ws.Cells(x, 11).Value = (close_price / open_price) - 1
End If
ws.Cells(x, 11).Style = "Percent"
If ws.Cells(x, 10).Value >= 0 Then
ws.Cells(x, 10).Interior.ColorIndex = 4
Else
ws.Cells(x, 10).Interior.ColorIndex = 3
End If
x = x + 1
ws.Cells(x, 9).Value = ws.Cells(i, 1).Value
ws.Cells(x, 10).Value = close_price - open_price
If close_price <= 0 Then
ws.Cells(x, 11).Value = 0
Else
ws.Cells(x, 11).Value = (close_price / open_price) - 1
End If
ws.Cells(x, 11).Style = "Percent"
If ws.Cells(x, 10).Value >= 0 Then
ws.Cells(x, 10).Interior.ColorIndex = 4
Else
ws.Cells(x, 10).Interior.ColorIndex = 3
End If
End If
Next i
Next ws
End Sub
You seem to have a logic problem - see the two marked lines below
'Ticker symbol output
If ws.Cells(i + 1, 1).Value <> ws.Cells(i, 1).Value Then '<<<<<<<<<
TickerRow = TickerRow + 1
Ticker = ws.Cells(i, 1).Value
ws.Cells(TickerRow, "I").Value = Ticker
'Stock Volume output
If ws.Cells(i, 1).Value = ws.Cells(i + 1, 1).Value Then '<<< never true!
stock_volume = stock_volume + ws.Cells(i, 7).Value
ElseIf ws.Cells(i, 1).Value <> Cells(i + 1, 1).Value Then
stock_volume = stock_volume + ws.Cells(i, 7).Value
ws.Cells(j, 9).Value = ws.Cells(i, 1).Value
ws.Cells(j, 12).Value = stock_volume
j = j + 1
stock_volume = 0
End If
This is my first experience writing any kind of code. I have been building a tracking system for my work in Excel. I have everything that I want currently working except I have a user form that when you click the command button it will look at my current inventory table (the table has a column (16 or P) that list how many cases of a product we should order to get us to our target stock quantity) and return a list of products and what we need to order. I have the form so it works, It populates a list box on the form with all the info that I want, but I would like it to exclude any rows that the table says we don't need to order. Here is my current code.
Private Sub CommandButton1_Click()
Dim ws As Worksheet
Dim i As Integer
Set ws = Worksheets("Current")
lstProd.Clear
lstProd.ColumnCount = 9
Dim LastRow As Long
LastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
For i = 1 To LastRow
lstProd.AddItem ws.Cells(i, 1).Value
lstProd.List(i - 1, 1) = ws.Cells(i, 2).Value
lstProd.List(i - 1, 2) = ws.Cells(i, 3).Value
lstProd.List(i - 1, 3) = "$" & Format(ws.Cells(i, 4).Value, "0.00")
lstProd.List(i - 1, 4) = ws.Cells(i, 5).Value
lstProd.List(i - 1, 5) = ws.Cells(i, 6).Value
lstProd.List(i - 1, 6) = ws.Cells(i, 9).Value
lstProd.List(i - 1, 7) = ws.Cells(i, 14).Value
lstProd.List(i - 1, 8) = ws.Cells(i, 16).Value
Next i
End Sub
I have tried a lot of if ws.cells(i, 16) = "0" and For ws.cells..... but always end up with different errors. I know it is something simple that I am missing but it has just eluded me so I thought I would break down and ask for help.
If "the table says we don't need to order" means there is an empty cell in the checked range you may use the next code:
For i = 1 To LastRow
If ws.Cells(i, 1).Value <> "" Then
lstProd.AddItem ws.Cells(i, 1).Value
lstProd.List(i - 1, 1) = ws.Cells(i, 2).Value
lstProd.List(i - 1, 2) = ws.Cells(i, 3).Value
lstProd.List(i - 1, 3) = "$" & Format(ws.Cells(i, 4).Value, "0.00")
lstProd.List(i - 1, 4) = ws.Cells(i, 5).Value
lstProd.List(i - 1, 5) = ws.Cells(i, 6).Value
lstProd.List(i - 1, 6) = ws.Cells(i, 9).Value
lstProd.List(i - 1, 7) = ws.Cells(i, 14).Value
lstProd.List(i - 1, 8) = ws.Cells(i, 16).Value
End if
Next i
If not, you must describe how those cells look/contain in order to make you understand "we don't need to order"...
Application Match for one column works but for 2 columns is giving me error
With Sht
LastRow = .Cells(.Rows.Count, "J").End(xlUp).Row
For i = LastRow To 2 Step -1
DupRow = Application.Match(Cells(i, 9).Value, Range(Cells(1, 9), Cells(i - 1, 9)), 0)
DoEvents
If Not IsError(DupRow) Then
Cells(i, 8).Value = Cells(i, 8).Value + Cells(DupRow, 8).Value
Cells(i, 9).Value = Cells(i, 9).Value + Cells(DupRow, 9).Value
Rows(DupRow).Delete
End If
Next i
End With
for 2 columns Error runtime 1004
DupRow = Application.Match(Cells(i, 4).Value & Cells(i, 5).Value, Range(Cells(1, 4) & Cells(1, 5), Cells(i - 1, 4) & Cells(i - 1, 5)), 0)
What is the correct way of doing this?
In my opinion it's better to use dictionary for that, which has built-in method for managing keys, so it can be used to get unique values:
Sub teest()
Dim val As String
Set dict = CreateObject("Scripting.Dictionary")
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
For i = LastRow To 2 Step -1
val = Cells(i, 1).Value & Cells(i, 2).Value
If dict.Exists(val) Then
Rows(i).Delete
Else
dict.Add val, 0
End If
Next
End Sub
please i need help on this code: it compares different values in different column at the same row level and executes the "then statement". But the code i wrote doesn't real function as i expected.
Sub Z_status()
Dim wsO As Worksheet
Set wsO = Sheets("Sending List")
Dim i As Long
Dim Lastrow As Long
With wsO
Lastrow = Cells(Rows.Count, 5).End(xlUp).Row
'Lastrow_2 = Cells(Rows.Count, 6).End(xlUp).Row
'Lastrow_3 = Cells(Rows.Count, 3).End(xlUp).Row
'Lastrow_4 = Cells(Rows.Count, 8).End(xlUp).Row
For i = Lastrow To 2 Step -1
'For j = Lastrow_2 To 2 Step -1
'For k = Lastrow_3 To 2 Step -1
'For l = Lastrow_3 To 2 Step -1
Cells(1, 7).Value = "Expected state"
If (Cells(i, 5).Value = "MTS" Or Cells(i, 5).Value = "MTO") And (Cells(i, 6).Value = "1/1/1900" Or Cells(i, 6).Value > Date) And (Cells(i, 3).Value = 0) And (Cells(i, 8).Value = 0) Then
Cells(i, 7).Value = "Z1"
ElseIf (Cells(i, 5).Value = "MTS" Or Cells(i, 5).Value = "MTO") And (Cells(i, 6).Value = "1/1/1900" Or Cells(i, 6).Value > Date) And (Cells(i, 3).Value = 0) And (Cells(i, 8).Value > 0 Or Cells(i, 8).Value = 0) Then
Cells(i, 7).Value = "Z3"
ElseIf (Cells(i, 5).Value = "MTS" Or Cells(i, 5).Value = "MTO") And (Cells(i, 6).Value = "1/1/1900" Or Cells(i, 6).Value > Date) And (Cells(i, 3).Value > 0) And (Cells(i, 8).Value > 0 Or Cells(i, 8).Value = 0) Then
Cells(i, 7).Value = "Z5"
ElseIf (Cells(i, 5).Value = "Obsolete") And (Cells(i, 6).Value < Date) And (Cells(i, 3).Value > 0) And (Cells(i, 8).Value > 0 Or Cells(i, 8).Value = 0) Then
Cells(i, 7).Value = "Z7"
ElseIf (Cells(i, 5).Value = "Obsolete") And (Cells(i, 6).Value < Date) And (Cells(i, 3).Value = 0) And (Cells(i, 8).Value = 0) Then
Cells(i, 7).Value = "Z9"
End If
Next i
' Next j
' Next k
' Next l
End With
End Sub
1 Your conditions for Z3 and z5 are identical
2 You can write
(Cells(i, 8).Value > 0 Or Cells(i, 8).Value = 0)
as (Cells(i, 8).Value >= 0 )
Your ifs can be written more clearly as
If (Cells(i, 5).Value = "MTS" Or Cells(i, 5).Value = "MTO") And (Cells(i, 6).Value = "1/1/1900" Or Cells(i, 6).Value > Date) Then
If (Cells(i, 8).Value = 0) Then
Cells(i, 7).Value = "Z1"
Else
If (Cells(i, 8).Value > 0) Then
Cells(i, 7).Value = "Z5"
End If
End If
Else
If (Cells(i, 5).Value = "Obsolete") Then
If (Cells(i, 6).Value < Date) And (Cells(i, 8).Value >= 0) Then
If (Cells(i, 3).Value > 0) Then
Cells(i, 7).Value = "Z7"
Else
If (Cells(i, 3).Value = 0) Then
Cells(i, 7).Value = "Z9"
Else
'This case is undefined
End If
End If
Else
'This case is undefined
End If
Else
'this case is undefined
End If
End If
Hopefully you can work out the errors more easily in this form