D
Dan R.
This code just copies values from the active ws to another wb and then
pastes values from the wb back to the active ws. It works fine but I
want to hide the wb and stop the screen updating until the code is
complete... How can I do this?
Sub Populate_H6()
Dim ws As Worksheet
Dim wb As Workbook
Dim rng As Range
Dim rCell As Range
Application.ScreenUpdating = False
Set ws = ActiveSheet
Set wb = Workbooks.Open("A:\Lookup.xls")
With ws
Set rng = .Range(.Cells(1, 1), _
.Cells(.Rows.Count, 2).End(xlUp))
End With
For Each rCell In rng.Cells
Select Case rCell.Value
Case "TiM"
rCell.Offset(0, 1).Copy wb.Worksheets(13) _
.Range(rCell.Address).Offset(3, 1)
rCell.Offset(0, 2).Copy wb.Worksheets(13) _
.Range(rCell.Address).Offset(3, 2)
wb.Worksheets(13).Range(rCell.Address) _
.Offset(3, 5).Copy ws.Range(rCell.Address).Offset(0, 3)
Case "MiM"
rCell.Offset(0, 1).Copy wb.Worksheets(13) _
.Range(rCell.Address).Offset(3, 7)
rCell.Offset(0, 2).Copy wb.Worksheets(13) _
.Range(rCell.Address).Offset(3, 8)
wb.Worksheets(13).Range(rCell.Address) _
.Offset(3, 11).Copy ws.Range(rCell.Address).Offset(0, 3)
Case "WiM"
rCell.Offset(0, 1).Copy wb.Worksheets(13) _
.Range(rCell.Address).Offset(3, 13)
rCell.Offset(0, 2).Copy wb.Worksheets(13) _
.Range(rCell.Address).Offset(3, 14)
wb.Worksheets(13).Range(rCell.Address) _
.Offset(3, 17).Copy ws.Range(rCell.Address).Offset(0, 3)
End Select
Next
With ws
ws.Columns("D").ClearFormats
ws.Columns("D").AutoFit
End With
wb.Close savechanges:=False
Application.ScreenUpdating = True
End Sub
Thank You,
-- Dan
pastes values from the wb back to the active ws. It works fine but I
want to hide the wb and stop the screen updating until the code is
complete... How can I do this?
Sub Populate_H6()
Dim ws As Worksheet
Dim wb As Workbook
Dim rng As Range
Dim rCell As Range
Application.ScreenUpdating = False
Set ws = ActiveSheet
Set wb = Workbooks.Open("A:\Lookup.xls")
With ws
Set rng = .Range(.Cells(1, 1), _
.Cells(.Rows.Count, 2).End(xlUp))
End With
For Each rCell In rng.Cells
Select Case rCell.Value
Case "TiM"
rCell.Offset(0, 1).Copy wb.Worksheets(13) _
.Range(rCell.Address).Offset(3, 1)
rCell.Offset(0, 2).Copy wb.Worksheets(13) _
.Range(rCell.Address).Offset(3, 2)
wb.Worksheets(13).Range(rCell.Address) _
.Offset(3, 5).Copy ws.Range(rCell.Address).Offset(0, 3)
Case "MiM"
rCell.Offset(0, 1).Copy wb.Worksheets(13) _
.Range(rCell.Address).Offset(3, 7)
rCell.Offset(0, 2).Copy wb.Worksheets(13) _
.Range(rCell.Address).Offset(3, 8)
wb.Worksheets(13).Range(rCell.Address) _
.Offset(3, 11).Copy ws.Range(rCell.Address).Offset(0, 3)
Case "WiM"
rCell.Offset(0, 1).Copy wb.Worksheets(13) _
.Range(rCell.Address).Offset(3, 13)
rCell.Offset(0, 2).Copy wb.Worksheets(13) _
.Range(rCell.Address).Offset(3, 14)
wb.Worksheets(13).Range(rCell.Address) _
.Offset(3, 17).Copy ws.Range(rCell.Address).Offset(0, 3)
End Select
Next
With ws
ws.Columns("D").ClearFormats
ws.Columns("D").AutoFit
End With
wb.Close savechanges:=False
Application.ScreenUpdating = True
End Sub
Thank You,
-- Dan