Solved: Copy Data from Excel sheet into Another Macro

[Holland]

Hello,
I've been trying to record a macro to copy info from the Data sheet to the Log_Status sheet (all in excel) and it's doesn't work. As a user enters a value into the Status_Log sheet tab Cell B5 only and then hit's the UpLoad button the form should load full of info pulled from the Data sheet tab.

The thing is B5 will always change depending on end users input, but the macro always reads 'ActiveCell.FormulaR1C1 = "PO" and always filters on the "PO" nothing else. Also please see attached copy Attachment 10559

Any help would be greatly appreciated!
Thank you,
Holland

[VBA]
'--------------

Sub UpLoad_Click()
'
' UpLoad_Click Macro
' Macro recorded 10/30/2008 by Holland McAdam
'
'
Range("B5").Select
ActiveCell.FormulaR1C1 = "PO"
Sheets("Data").Select
Rows("1:1").Select
Selection.AutoFilter
Range("A9").Select
Selection.AutoFilter Field:=1, Criteria1:="=PO", Operator:=xlAnd
Range("C8").Select
ActiveCell.FormulaR1C1 = "test strobes 6"
Sheets("Status_Log (2)").Select
Range("B6").Select
ActiveCell.FormulaR1C1 = "test strobes 6"
Range("B7").Select
Sheets("Data").Select
Range("D8").Select
ActiveCell.FormulaR1C1 = "ABC"
Sheets("Status_Log (2)").Select
ActiveCell.FormulaR1C1 = "ABC"
Range("B8").Select
Sheets("Data").Select
Range("E8").Select
ActiveCell.FormulaR1C1 = "N/A"
Sheets("Status_Log (2)").Select
ActiveCell.FormulaR1C1 = "N/A"
Range("A11").Select
Sheets("Data").Select
Range("B8:B50").Select
ActiveWindow.SmallScroll Down:=-39
Range("B2:B50").Select
ActiveWindow.SmallScroll Down:=-30
Selection.Copy
Sheets("Status_Log (2)").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("B11").Select
Sheets("Data").Select
Range("F2:F50").Select
ActiveWindow.SmallScroll Down:=-36
Application.CutCopyMode = False
Selection.Copy
Sheets("Status_Log (2)").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A3:B3").Select
Sheets("Data").Select
Rows("1:1").Select
Application.CutCopyMode = False
Selection.AutoFilter
Range("G2").Select
ActiveWindow.SmallScroll Down:=-15
Sheets("Status_Log (2)").Select
End Sub
[/VBA]

[mdmackillop]

Hi Holland
Welcome to VBAX
This may not give expected results for all cases. Enter PO or MR in Cell B5 then run this code from the button
[VBA]
Option Explicit
Sub UpLoad_Click()
Dim WS As Worksheet
Dim Rng As Range
Set WS = Sheets("Status_Log (2)")
With Sheets("Data")
.Columns("A:F").AutoFilter Field:=1, Criteria1:=WS.Range("B5").Text
Set Rng = .Range(.Cells(2, 1), .Cells(Rows.Count, 1).End(xlUp)).SpecialCells(xlCellTypeVisible)
WS.Range("B6") = Rng(1).Offset(, 2)
WS.Range("B7") = Rng(1).Offset(, 3)
WS.Range("B8") = Rng(1).Offset(, 4)
Rng.Offset(, 1).Copy
WS.Range("A11").PasteSpecial xlValues
Rng.Offset(, 5).Copy
WS.Range("B11").PasteSpecial xlValues
.Columns("A:F").AutoFilter
End With
WS.Range("B5").Select
End Sub

[/VBA]

[Holland]

Thank you very much, works amazing I also added a sort filter by date to the script. Now if B5 is empty how do I raise a pop up, currently if B5 is empty it still populates some cells (using the below script). Again THANK YOU for your assistance.

Sub UpLoad_Click()
Dim WS As Worksheet
Dim Rng As Range
Set WS = Sheets("Status_Log (2)")
With Sheets("Data")
.Columns("A:F").AutoFilter Field:=1, Criteria1:=WS.Range("B5").Text
Set Rng = .Range(.Cells(2, 1), .Cells(Rows.Count, 1).End(xlUp)).SpecialCells(xlCellTypeVisible)
WS.Range("B6") = Rng(1).Offset(, 2)
WS.Range("B7") = Rng(1).Offset(, 3)
WS.Range("B8") = Rng(1).Offset(, 4)
Rng.Offset(, 1).Copy
WS.Range("A11").PasteSpecial xlValues
Rng.Offset(, 5).Copy
WS.Range("B11").PasteSpecial xlValues
.Columns("A:F").AutoFilter
End With
WS.Range("B5").Select
Range("A10:B27").Sort Key1:=Range("A11"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End Sub

[mdmackillop]

[vba]
Set WS = Sheets("Status_Log (2)")
'Add this
If ws.range("B5") = "" then
msgbox "Please enter data in B5"
Exit Sub
End if
[/vba]

[Holland]

Maybe I am putting it in the wrong sequence / place, not working for me.

If ws.range("B5") = "" then
msgbox

[mdmackillop]

[VBA]
Option Explicit
Sub UpLoad_Click()
Dim WS As Worksheet
Dim Rng As Range
Set WS = Sheets("Status_Log (2)")
If WS.Range("B5") = "" Then
MsgBox "Please enter data in B5"
Exit Sub
End If
With Sheets("Data")
.Columns("A:F").AutoFilter Field:=1, Criteria1:=WS.Range("B5").Text
Set Rng = .Range(.Cells(2, 1), .Cells(Rows.Count, 1).End(xlUp)).SpecialCells(xlCellTypeVisible)
WS.Range("B6") = Rng(1).Offset(, 2)
WS.Range("B7") = Rng(1).Offset(, 3)
WS.Range("B8") = Rng(1).Offset(, 4)
Rng.Offset(, 1).Copy
WS.Range("A11").PasteSpecial xlValues
Rng.Offset(, 5).Copy
WS.Range("B11").PasteSpecial xlValues
.Columns("A:F").AutoFilter
End With
WS.Range("B5").Select
End Sub
[/VBA]

[Holland]

You are truely great at what you do many, many thx works great. I will further test when I get home tonight and leave feed-back again.

Thank you very much!

[Holland]

What about if the info entered into B5 can't be found, currently I can enter anything into B5 that isn't in the Data sheet and it still populates B6, B7, B8, A11 and B11 with the headings from the Data sheet? Is there a way to create another message box stipulating "try again" or something and not populating B6, B7, B8, A11 and B11 with the headings from the Data sheet?

Sorry if this sounds confusing.

[mdmackillop]

[VBA]Option Explicit
Sub UpLoad_Click()
Dim WS As Worksheet
Dim Rng As Range
Set WS = Sheets("Status_Log (2)")
If WS.Range("B5") = "" Then
MsgBox "Please enter data in B5"
Exit Sub
End If
With Sheets("Data")
.Columns("A:F").AutoFilter Field:=1, Criteria1:=WS.Range("B5").Text
Set Rng = .Range(.Cells(2, 1), .Cells(Rows.Count, 1).End(xlUp)).SpecialCells(xlCellTypeVisible)
If Rng(1).Row = 1 Then
MsgBox "Data not found"
GoTo Exits
End If
WS.Range("B6") = Rng(1).Offset(, 2)
WS.Range("B7") = Rng(1).Offset(, 3)
WS.Range("B8") = Rng(1).Offset(, 4)
Rng.Offset(, 1).Copy
WS.Range("A11").PasteSpecial xlValues
Rng.Offset(, 5).Copy
WS.Range("B11").PasteSpecial xlValues
.Columns("A:F").AutoFilter
End With
Exits:
Sheets("Data").Columns("A:F").AutoFilter
WS.Range("B5").Select
End Sub
[/VBA]

[rbrhodes]

Hi Holland,

md beat me to it but here's another version...


What are you trying to do with the Userform I wonder?

[Holland]

Thank you both for your assistance I am almost there see my notes attached and new form and 4 points Attachment 10564

also I stuck in another sheet so you have an example of the print settings.

Again thank you for your assistance.

[mdmackillop]

Hi,
Can you post this as a new question. I've not much time and you should get a quicker response
Regards
MD

[Holland]

OK, thx agn MD