Missing Data

J

Jeff Gross

I need to write some code to look for missing data. Each month a facility is
supposed to enter data for that month. I have to download a file which has
this monthly data for several facilities compiled into one file. What I need
the code to do is look at the date in a cell (B5) and then search the
document for the hours associated with that month. If a facility did not
enter their data, then I need the code to copy the previous month's hours
into the current months hours. For example:

B5 = Apr 07

A B C D
9 Jan Feb Mar Apr
10 200 299 104 0
11 400 400 333 233
12 200 300 900 100
13 233 444 555 0
I want to code to change the "0" in column D at row 10 to "104" and D13 from
"0" to "555".

Thanks.

Jeff
 
O

Otto Moehrbach

Perhaps something like this. Note that this code will produce an error if
the month in B5 is January because there is no column to the left of Column
A.
Sub Update()
Dim TheRng As Range
Dim i As Range
Dim TheMonthsRng As Range
Dim TheMonth As String
Dim Col As Long
TheMonth = Format(Range("B5").Value, "mmm")
Set TheMonthsRng = Range("A9", Cells(9, Columns.Count).End(xlToLeft))
Col = TheMonthsRng.Find(What:=TheMonth, Lookat:=xlWhole).Column
Set TheRng = Range(Cells(9, Col), Cells(Rows.Count, Col).End(xlUp))
For Each i In TheRng
If i.Value = "" Or i.Value = 0 Then _
i.Value = i.Offset(, -1).Value
Next i
End Sub
 
J

Joel

Try this code. I didn't know if the date in B5 was a serial date (formated
as date) or a text string. code is shown as a serial date, but I included a
commented line if it is really a string.


Sub completedata()

Lastcol = Cells(9, Columns.Count).End(xlToLeft).Column
Set MonthRange = Range("a9", Cells(9, Lastcol))

'get month name if it is date format
mname = Left(MonthName(Month(Range("B5"))), 3)
'uncomment line if month is string
mname = Range("B5")

Set c = MonthRange.Find(what:=mname, LookIn:=xlValues)
If c Is Nothing Then
MsgBox ("Can't find month " & mname)
Else
If c.Column <> 1 Then
Lastrow = Cells(Rows.Count, c.Column).End(xlUp).Row
For RowCount = 10 To Lastrow
If Cells(RowCount, c.Column) = 0 Then
Cells(RowCount, c.Column) = Cells(RowCount, c.Column - 1)
End If
Next RowCount
Else
MsgBox ("Can't update Column A on worksheet")
End If
End If
End Sub
 
J

Jeff Gross

What if the data for each month wa not actually next to each other. For
example, January = Column BB
February = Column BR
March = Column CH
April = Column CX
May = Column DN
June = Column ED
July = Column ET
August = Column FJ
September = Column FZ
October = Column GP
November = Column HF
December = Column HV
 
J

Joel

It should make a difference.

Lastcol = Cells(9, Columns.Count).End(xlToLeft).Column
Set MonthRange = Range("a9", Cells(9, Lastcol))

The above statement finds the last column in row 9 and then sets the entire
row 9 to a range call MonthRange.

Set c = MonthRange.Find(what:=mname, LookIn:=xlValues)

The above line searches the entire row 9 for the month name.
 
O

Otto Moehrbach

The code I gave you searches for the month in row 1 so it doesn't matter in
what column the month is. HTH Otto
 
J

Jeff Gross

Here is my current code but the data is not getting copied from the previous
month when it is zero in the current month.

Sub UpdateMissingData()

Const MonthlyNameWbkName = "C:\Reports\DNLD\HS_Monthly.xls"
Const MasterSheet = "HS_Monthly" 'contains long names

Workbooks.Open Filename:=MonthlyNameWbkName

Dim TheRng As Range
Dim i As Range
Dim TheMonthsRng As Range
Dim TheMonth As String
Dim Col As Long

TheMonth = Format(Range("B5").Value, "mmmm")
Set TheMonthsRng = Range("A7", Cells(9, Columns.Count).End(xlToLeft))
Col = TheMonthsRng.Find(What:=TheMonth, Lookat:=xlWhole).Column
Set TheRng = Range(Cells(9, Col), Cells(Rows.Count, Col).End(xlUp))
For Each i In TheRng
If i.Value = "0" Or i.Value = 0 Then _
i.Value = i.Offset(, -1).Value
Next i
ActiveWorkbook.Save
ActiveWorkbook.Close
End Sub

My current month is in cell B5 and is formatted as date (mmmm).
The months are located in row 7.
The data begins in row 9.

jeff
 
J

Jeff Gross

Joel - I've tried your code as follows but it does not copy the previous
months hours when there is a zero in the current month's hours. Here is the
code:


Sub completedata()

Const MonthlyWbkName = "C:\Reports\DNLD\HS_Monthly.xls"
Const MasterSheet = "HS_Monthly" 'contains long names

Set MonthlyWbk = ThisWorkbook
Workbooks.Open Filename:=MonthlyWbkName

Lastcol = Cells(9, Columns.Count).End(xlToLeft).Column
Set MonthRange = Range("a7", Cells(7, Lastcol))

'get month name if it is date format
mname = MonthName(Month(Range("B5")))
'uncomment line if month is string
'mname = Range("b5")


Set c = MonthRange.Find(What:=mname, LookIn:=xlValues)
If c Is Nothing Then
MsgBox ("Can't find month " & mname)
Else
If c.Column <> 1 Then
Lastrow = Cells(Rows.Count, c.Column).End(xlUp).Row
For RowCount = 9 To Lastrow
If Cells(RowCount, c.Column) = 0 Then
Cells(RowCount, c.Column) = Cells(RowCount, c.Column - 1)
End If
Next RowCount
Else
MsgBox ("Can't update Column A on worksheet")
End If
End If
ActiveWorkbook.Save
ActiveWorkbook.Close
End Sub
 
J

Joel

The problem is simple. MonthName return the full name of the month liked
April. You header row only has three characters. My original code used left
to get the first three letters of the month name. The line below needs to be
modified. You r code was producing the msgbox saying it couldn't find the
month name when I ran the code.

mname = Left(MonthName(Month(Range("B5"))), 3)
 
J

Jeff Gross

I made the change back to your original code and now I see what it is doing.
When the current month cell is 0, it copies the previous column value. The
issue is that the months are not adjacent to each other but are separated by
16 columns of other data. How would I go about getting it to copy the value
16 columns before the current month?

Jeff
 
J

Joel

I forgot that your columns are not next ot each other. Need to do a search
for the previous month. The code searches Month(Range("B5") - 1 using the
first 3 letters of the month name.

Sub completedata()

Const MonthlyWbkName = "C:\Reports\DNLD\HS_Monthly.xls"
Const MasterSheet = "HS_Monthly" 'contains long names

Set MonthlyWbk = ThisWorkbook
Workbooks.Open Filename:=MonthlyWbkName

Lastcol = Cells(9, Columns.Count).End(xlToLeft).Column
Set MonthRange = Range("a7", Cells(7, Lastcol))

'get month name if it is date format
mname = Left(MonthName(Month(Range("B5"))), 3)
'uncomment line if month is string
'mname = Range("b5")


Set C = MonthRange.Find(What:=mname, LookIn:=xlValues)
If C Is Nothing Then
MsgBox ("Can't find month " & mname)
Else
If C.Column <> 1 Then
Lastrow = Cells(Rows.Count, C.Column).End(xlUp).Row
For RowCount = 9 To Lastrow
If Cells(RowCount, C.Column) = 0 Then
If Month(Range("B5")) > 1 Then 'skip january
Lastmname = Left(MonthName(Month(Range("B5")) - 1), 3)
Set CLast = MonthRange.Find(What:=Lastmname, LookIn:=xlValues)
If Not CLast Is Nothing Then
Cells(RowCount, C.Column) = Cells(RowCount, CLast.Column)
End If
End If
End If
Next RowCount
Else
MsgBox ("Can't update Column A on worksheet")
End If
End If
ActiveWorkbook.Save
ActiveWorkbook.Close
End Sub
 
J

Jeff Gross

That did it. Thanks a lot. That's the second time you helped me with this
spreadsheet project. Take care. I've been trying to locate a good class on
VBA for excel but haven't been able to find one yet.

Jeff
 
J

Joel

Your programming skills look good. It just the understanding of algorithms
that takes time to learn. I'm using techniques that I did with Pascal,
Fortran, asembly language over 20 years ago and applying these techniques to
VBA. The algorithms haven't changed, only the language.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top