Need VBA help with populating missing data??

[jodyjo65]

Please see attached Excel 2007 xlsm file.....



Sheet "Input (9) Sept 2009" is mainly an input sheet for data collected on patients on a day to day Basis. From the Data on This sheet I would like to run code to produce what is listed manually on Sheet "DD (9) Sept 2009". Please Note the addition of the column in yellow "Infection dates". This column compares the "Onset Date" and the "Date Resolved" from Sheet "Input (9) Sept 2009" and the code automatically list both of those dates plus all the days in between and puts it in the Infection Dates Column Highlighted in Yellow. All other date in each row is just identical to the data entered on Sheet "Input (9) Sept 2009" . I don't care whether the code generates the new Sheet "DD (9) Sept 2009" or not. It is OK with me if I just duplicate the first sheet then run the code and rename the sheet.



Data for Drop Downs is listed at bottom....



Thanks so much in advance for anyone who is willing to help me figure this out!!!



My direct email is henderson-nviaa@att.net

[Bob Phillips]

Public Sub ProcessData()
Dim sh As Worksheet
Dim shName As String
Dim LastRow As Long
Dim NumRows As Long
Dim i As Long, j As Long

With ActiveSheet

shName = Replace(.Name, "Input", "DD")
On Error Resume Next
Set sh = Worksheets(shName)
On Error GoTo 0
If sh Is Nothing Then

Set sh = .Parent.Worksheets.Add
sh.Name = shName
Else

sh.UsedRange.ClearContents
End If

LastRow = .Cells(157, "B").End(xlUp).Row
.Range("A1").Resize(LastRow, 26).Copy sh.Range("A1")
.Columns("A:Z").Copy
sh.Columns("A:Z").PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
sh.Columns("E").Insert

For i = LastRow To 7 Step -1

NumRows = sh.Cells(i, "R").Value - sh.Cells(i, "F").Value
If NumRows > 1 Then

sh.Rows(i + 1).Resize(NumRows - 1).Insert
sh.Rows(i).Copy sh.Cells(i + 1, "A").Resize(NumRows - 1)
For j = 1 To NumRows

sh.Cells(i + j - 1, "E").Value = sh.Cells(i, "F").Value + j - 1
Next j
End If
Next i

sh.Range("B7").Select
.Range("B7").Select
End With

Set sh = Nothing

End Sub

[jodyjo65]

Public Sub ProcessData()
Dim sh As Worksheet
Dim shName As String
Dim LastRow As Long
Dim NumRows As Long
Dim i As Long, j As Long

With ActiveSheet

shName = Replace(.Name, "Input", "DD")
On Error Resume Next
Set sh = Worksheets(shName)
On Error GoTo 0
If sh Is Nothing Then

Set sh = .Parent.Worksheets.Add
sh.Name = shName
Else

sh.UsedRange.ClearContents
End If

LastRow = .Cells(157, "B").End(xlUp).Row
.Range("A1").Resize(LastRow, 26).Copy sh.Range("A1")
.Columns("A:Z").Copy
sh.Columns("A:Z").PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
sh.Columns("E").Insert

For i = LastRow To 7 Step -1

NumRows = sh.Cells(i, "R").Value - sh.Cells(i, "F").Value
If NumRows > 1 Then

sh.Rows(i + 1).Resize(NumRows - 1).Insert
sh.Rows(i).Copy sh.Cells(i + 1, "A").Resize(NumRows - 1)
For j = 1 To NumRows

sh.Cells(i + j - 1, "E").Value = sh.Cells(i, "F").Value + j - 1
Next j
End If
Next i

sh.Range("B7").Select
.Range("B7").Select
End With

Set sh = Nothing

End Sub



Hey that worked great!!! It gave a "Run Time Error 1004" but when I just clicked end it had worked perfect. The only thing that it did not do was name the new column generated Infection Dates. I don't know if that was part of the code or not, but I can live with that, unless you see a quick fix?? Thank you so much for the help!!! Your a lifesaver!!!

[Bob Phillips]

Public Sub ProcessData()
Dim sh As Worksheet
Dim shName As String
Dim LastRow As Long
Dim NumRows As Long
Dim i As Long, j As Long

With ActiveSheet

shName = Replace(.Name, "Input", "DD")
On Error Resume Next
Set sh = Worksheets(shName)
On Error Goto 0
If sh Is Nothing Then

Set sh = .Parent.Worksheets.Add
sh.Name = shName
Else

sh.UsedRange.ClearContents
End If

LastRow = .Cells(157, "B").End(xlUp).Row
.Range("A1").Resize(LastRow, 26).Copy sh.Range("A1")
.Columns("A:Z").Copy
sh.Columns("A:Z").PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
sh.Columns("E").Insert
sh.Range("E4").Value = "Infection"
sh.Range("E5").Value = "Dates"

For i = LastRow To 7 Step -1

NumRows = sh.Cells(i, "R").Value - sh.Cells(i, "F").Value
If NumRows > 1 Then

sh.Rows(i + 1).Resize(NumRows - 1).Insert
sh.Rows(i).Copy sh.Cells(i + 1, "A").Resize(NumRows - 1)
For j = 1 To NumRows

sh.Cells(i + j - 1, "E").Value = sh.Cells(i, "F").Value + j - 1
Next j
End If
Next i

sh.Range("B7").Select
.Activate
.Range("B7").Select
End With

Set sh = Nothing

End Sub