code starts fromt he Listbox3_Click procedure.
Accidently added the preceeding code too.
Jim thank you for the reply.
I tried your code and i think it will be perfect, but i am not sure how to fit it into my existing
code.
The end section is where i am unsure.
I have placed my entire procedure below, if you could adapt it with your code instead of the one i
had if possible to show me where to place it.
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Private Sub ListBox2_Click()
Application.ScreenUpdating = False
Sheets("Data2").Visible = True
ListBox3.Clear
Dim LastCell As Long
Dim myrow As Long
Sheets("Data2").Visible = True
LastCell = Worksheets("Data2").Cells(Rows.Count, "A").End(xlUp).Row
With ActiveWorkbook.Worksheets("Data2")
..Select 'first thing to do with a With statement that occurs on a second sheet
For myrow = 1 To LastCell
If .Cells(myrow, 18).Value <> "" Then
If ListBox1.Value = .Cells(myrow, 2).Value And ListBox2.Text = .Cells(myrow, 3).Text Then
ListBox3.AddItem .Cells(myrow, 18).Value
End If
End If
Next
End With
Sheets("Data2").Visible = False
Sheets("POST Project Report").Select
Application.ScreenUpdating = True
End Sub
Private Sub ListBox3_Click()
Application.ScreenUpdating = False
UserForm3.Hide
With ActiveWorkbook.Worksheets("POST Project Report")
..Select
Dim rngFound As Range
On Error Resume Next
Sheets("Data2").Visible = True
Sheets("Data2").Unprotect
With Worksheets("Data2").Range("C:C")
Set rngFound = .Find(What:=ListBox2.Value, After:=.Cells(1), LookIn:=xlValues, LookAt:=xlWhole,
SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, Matchbyte:=False)
If rngFound.Value <> "" And ListBox3.Value = rngFound.Offset(0, 15).Value Then
' Place data from Data sheet into Report Layout Sheet
Range("E18:O18").Value = rngFound.Offset(0, -2).Value
Range("E20:O20").Value = rngFound.Offset(0, -1).Value 'ListBox1.Value
Range("E22:H22").Value = rngFound.Value 'ListBox2.Value
Range("L22:O22").Value = rngFound.Offset(0, 1).Value
Range("E24:O28").Value = rngFound.Offset(0, 2).Value
Range("E30:H30").Value = rngFound.Offset(0, 3).Value
Range("E32:H32").Value = rngFound.Offset(0, 4).Value
Range("E34:H34").Value = rngFound.Offset(0, 5).Value
Range("E36:H36").Value = rngFound.Offset(0, 6).Value
Range("E38:H38").Value = rngFound.Offset(0, 7).Value
Range("J30:M30").Value = rngFound.Offset(0, 8).Value
Range("J32:M32").Value = rngFound.Offset(0, 9).Value
Range("J34:M34").Value = rngFound.Offset(0, 10).Value
Range("J36:M36").Value = rngFound.Offset(0, 11).Value
Range("J38:M38").Value = rngFound.Offset(0, 12).Value
Range("C42:O52").Value = rngFound.Offset(0, 13).Value
Range("C56:O60").Value = rngFound.Offset(0, 14).Value
Range("I62:N62").Value = rngFound.Offset(0, 15).Value 'ListBox3.Value
Range("I64:N64").Value = rngFound.Offset(0, 16).Value
Range("E68:G68").Value = rngFound.Offset(0, 17).Value
Range("E70:G70").Value = rngFound.Offset(0, 18).Value
Range("E72:G72").Value = rngFound.Offset(0, 19).Value
Range("L68:N68").Value = rngFound.Offset(0, 20).Value
Range("L70:N70").Value = rngFound.Offset(0, 21).Value
Range("L72:N72").Value = rngFound.Offset(0, 22).Value
Range("C112").Value = rngFound.Offset(0, 23).Value
Range("C135").Value = rngFound.Offset(0, 24).Value
Range("C173").Value = rngFound.Offset(0, 25).Value
Range("C196").Value = rngFound.Offset(0, 26).Value
Range("C233").Value = rngFound.Offset(0, 27).Value
Range("C256").Value = rngFound.Offset(0, 28).Value
' Insert Photo 1 from Photo Address located on PC
Application.ScreenUpdating = False
If Range("C112").Value <> "" Then
Range("C97").Select
ActiveSheet.Unprotect
Dim WB As Workbook
Dim SH As Worksheet
Dim rng As Range
Dim mypic As Picture
Dim res As Variant
Set WB = ActiveWorkbook
res = rngFound.Offset(0, 23).Value
If res = False Then Exit Sub
Set SH = ActiveSheet
Set rng = ActiveCell
Set mypic = SH.Pictures.Insert(res)
With mypic
.Top = rng.Top
.Left = rng.Left
.Locked = False
mypic.ShapeRange.LockAspectRatio = msoFalse
mypic.ShapeRange.Height = 213.1
mypic.ShapeRange.Width = 249.2
mypic.ShapeRange.Rotation = 0#
ActiveCell.Offset(1, 0).Value = res
End With
End If
' Insert Photo 2 from Photo Address located on PC
Application.ScreenUpdating = False
If Range("C135").Value <> "" Then
Range("C119").Select
Set WB = ActiveWorkbook
res = rngFound.Offset(0, 24).Value
If res = False Then Exit Sub
Set SH = ActiveSheet
Set rng = ActiveCell
Set mypic = SH.Pictures.Insert(res)
With mypic
.Top = rng.Top
.Left = rng.Left
.Locked = False
mypic.ShapeRange.LockAspectRatio = msoFalse
mypic.ShapeRange.Height = 213.1
mypic.ShapeRange.Width = 249.2
mypic.ShapeRange.Rotation = 0#
ActiveCell.Offset(1, 0).Value = res
End With
End If
' Insert Photo 3 from Photo Address located on PC
Application.ScreenUpdating = False
If Range("C173").Value <> "" Then
Range("C158").Select
Set WB = ActiveWorkbook
res = rngFound.Offset(0, 25).Value
If res = False Then Exit Sub
Set SH = ActiveSheet
Set rng = ActiveCell
Set mypic = SH.Pictures.Insert(res)
With mypic
.Top = rng.Top
.Left = rng.Left
.Locked = False
mypic.ShapeRange.LockAspectRatio = msoFalse
mypic.ShapeRange.Height = 213.1
mypic.ShapeRange.Width = 249.2
mypic.ShapeRange.Rotation = 0#
ActiveCell.Offset(1, 0).Value = res
End With
End If
' Insert Photo 4 from Photo Address located on PC
Application.ScreenUpdating = False
If Range("C196").Value <> "" Then
Range("C180").Select
Set WB = ActiveWorkbook
res = rngFound.Offset(0, 26).Value
If res = False Then Exit Sub
Set SH = ActiveSheet
Set rng = ActiveCell
Set mypic = SH.Pictures.Insert(res)
With mypic
.Top = rng.Top
.Left = rng.Left
.Locked = False
mypic.ShapeRange.LockAspectRatio = msoFalse
mypic.ShapeRange.Height = 213.1
mypic.ShapeRange.Width = 249.2
mypic.ShapeRange.Rotation = 0#
ActiveCell.Offset(1, 0).Value = res
End With
Application.ScreenUpdating = True
End If
' Insert Photo 5 from Photo Address located on PC
Application.ScreenUpdating = False
If Range("C233").Value <> "" Then
Range("C218").Select
Set WB = ActiveWorkbook
res = rngFound.Offset(0, 27).Value
If res = False Then Exit Sub
Set SH = ActiveSheet
Set rng = ActiveCell
Set mypic = SH.Pictures.Insert(res)
With mypic
.Top = rng.Top
.Left = rng.Left
.Locked = False
mypic.ShapeRange.LockAspectRatio = msoFalse
mypic.ShapeRange.Height = 213.1
mypic.ShapeRange.Width = 249.2
mypic.ShapeRange.Rotation = 0#
ActiveCell.Offset(1, 0).Value = res
End With
End If
' Insert Photo 6 from Photo Address located on PC
Application.ScreenUpdating = False
If Range("C256").Value <> "" Then
Range("C240").Select
Set WB = ActiveWorkbook
res = rngFound.Offset(0, 28).Value
If res = False Then Exit Sub
Set SH = ActiveSheet
Set rng = ActiveCell
Set mypic = SH.Pictures.Insert(res)
With mypic
.Top = rng.Top
.Left = rng.Left
.Locked = False
mypic.ShapeRange.LockAspectRatio = msoFalse
mypic.ShapeRange.Height = 213.1
mypic.ShapeRange.Width = 249.2
mypic.ShapeRange.Rotation = 0#
ActiveCell.Offset(1, 0).Value = res
End With
End If
Application.ScreenUpdating = False
' Place Text back in cells
Range("L101
108").Value = rngFound.Offset(0, 29).Value
Range("L124
131").Value = rngFound.Offset(0, 30).Value
Range("L162
169").Value = rngFound.Offset(0, 31).Value
Range("L185
192").Value = rngFound.Offset(0, 32).Value
Range("L222
229").Value = rngFound.Offset(0, 33).Value
Range("L245
252").Value = rngFound.Offset(0, 34).Value
' Place text back in cells
Range("C113:O117").Value = rngFound.Offset(0, 35).Value
Range("C136:O141").Value = rngFound.Offset(0, 36).Value
Range("C174:O178").Value = rngFound.Offset(0, 37).Value
Range("C197:O202").Value = rngFound.Offset(0, 38).Value
Range("C234:O238").Value = rngFound.Offset(0, 39).Value
Range("C257:O262").Value = rngFound.Offset(0, 40).Value
End If
End With
' Preview worksheet to either Print of simply View
Application.ScreenUpdating = False
If Range("C112").Value = "" Then Range("A1:R84").Select
If Range("C112").Value <> "" And Range("C173").Value = "" Then Range("A1:R146").Select
If Range("C112").Value <> "" And Range("C173").Value <> "" _
And Range("C233").Value = "" Then Range("A1:R206").Select
If Range("C112").Value <> "" And Range("C173").Value <> "" _
And Range("C233").Value <> "" Then Range("A1:R266").Select
ActiveSheet.PageSetup.PrintArea = Selection.Address
ActiveWindow.SelectedSheets.PrintPreview
' Remove the data from the report layout sheet
Dim c As Range
For Each c In Sheets("POST Project Report").UsedRange
If c.Locked = False Then
c.Value = ""
End If
Next
Application.ScreenUpdating = False
Sheets("POST Project Report").Activate
Application.ScreenUpdating = False
' Remove the photo's from the layour sheet
Call Remove_Images
Application.ScreenUpdating = False
On Error GoTo 0
End With
Unload Me
Application.ScreenUpdating = False
Range("A1").Select
Sheets("Data2").Protect
Sheets("Data2").Visible = False
Sheets("POST Project Report").Protect
Application.ScreenUpdating = True
End Sub
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
A couple of things. rngFound will be the first matching item found. You did
not post the code for your loop so it is hard to comment. Secondly Listboxes
return text values where as the cell contains a date. You are comparing
apples and oranges. You are probalby best off to compare text to text
something like this...
If ListBox3.Value = format(rngFound.Offset(0, 15).Value, "dd/mm/yyyy") Then
so I would expect to see somthing like this
Dim rngFound As Range
Dim strFirstAddress As String
Dim blnFound As Boolean
Sheets("Data2").Visible = True
Sheets("Data2").Unprotect
With Worksheets("Data2").Range("C:C")
Set rngFound = .Find(What:=ListBox2.Value, _
After:=.Cells(1), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
Matchbyte:=False)
If Not rngFound Is Nothing Then
strFirstAddress = rngFound.Address
Do
If ListBox3.Value = Format(rngFound.Offset(0, 15).Value,
"dd/mm/yyyy") Then
blnFound = True
Exit Do
End If
Set rngFound = .FindNext(rngFound)
Loop Until rngFound.Address = strFirstAddress
End If
If blnFound = True Then MsgBox rngFound.Address
End With