Hi Again,
My macros aren't playing nicely together.
My fisrt "GetWebData" is solid.
My Second "TrimRange" is solid when I run it on it's own but using the "Call" function at the end of "GetWebData", it doens't seem to trim anything else but the 1st cell, "D9" in this case.
Also, the Trimed Range (column D) in the "WebDrop" worksheet is part of a Vlookup, cell T9 =VLOOKUP(D9,Air!$A$2:$K$10002,8,FALSE), so the data must be trimed for the Vlookup to function. Once T9, T10, T2000 are done Vlookin-up only then should my third macro activate.
My 3rd macro, "CopyData" would copy the specified fields from sheet "WebDrop" to my final clean cut "DCC" sheet.
Now:
A) can I alternate my vlookup the work without using the "TrimRange" macro
B) can I built my Vlookup as part of a macro?
As it is, T9 to T2000 all contain the Vlookup formula stated above.
C) Any ideas how to clean / tweak these macros?
Thanks in advance.
Cheers,
Sprucy
-----------------------
Sub III_GetWebData()
'
' DOF Macro
' Macro recorded 11/20/2005 by
'Open site if it requires a PassWord Model or field input validation
Dim ie As Object
Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = True
'Go to this Web Page:
ie.Navigate "http://Private.Intranet.sorry"
'Check for good connection to web page loop!
Do
If ie.ReadyState = 4 Then
ie.Visible = False
Exit Do
Else
DoEvents
End If
Loop
'Wait for window to open!
Application.Wait (Now + TimeValue("0:00:02"))
'MsgBox "Done"
ie.Visible = True
'Send date based on Cell A1!
SendKeys "{TAB}", True
SendKeys "{TAB}", True
'May need additional SendKeys as needed?
'Determine by the actual key-stroks needed!
SendKeys [a1].Value, True
SendKeys "{TAB}", True
SendKeys "{ENTER}", True
Application.Wait (Now + TimeValue("0:00:02"))
With ie
.Visible = True
DoEvents
.ExecWB 17, 2
.ExecWB 12, 2
Sheet2.Paste Sheets("WebDrop").Range("A1")
End With
Application.Wait (Now + TimeValue("0:00:01"))
ie.Quit
'Added WebDrop!
Range("WebDrop!H2").Select
Call IV_TrimRange
End Sub
-----------------------------
Sub IV_TrimRange()
'
' TrimRange Macro
' Macro recorded 11/15/2005 by
Dim WorkRange As Range
Set WorkRange = Range("WebDrop!D9:D" & Range("D65536").End(xlUp).Row)
For Each Cell In WorkRange
If Cell.Value = "" Then
GoTo Next1
ElseIf IsNumeric(Cell.Value) Then
Cell.Value = Cell.Value * 1
Else
Cell.Value = Trim(Cell.Value)
End If
Next1:
Next Cell
'Application.Wait (Now + TimeValue("0:00:20"))
'Tried increasing the time to let the "triming" finish.
Call V_CopyData
End Sub
--------------------------------------
Sub V_CopyData()
'Application.Wait (Now + TimeValue("0:00:06"))
'Same as above, tweaking the time frame...not working!
'Copies Web results from "WebDrop" to "DCC" as values only
Sheets("WebDrop").Select
Range("a9:g65536").Copy
Sheets("DCC").Range("a4").PasteSpecial Paste:=xlPasteAll, Operation:=xlPasteSpecialOperationNone, SkipBlanks:=False, Transpose:=False
'Column T values are based VLOOKUP formula
Range("T9:T65536").Select
Selection.Copy
Sheets("DCC").Select
Range("J4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Sheets("DCC").Range("H2").Select
End Sub
-------------------------------
My macros aren't playing nicely together.
My fisrt "GetWebData" is solid.
My Second "TrimRange" is solid when I run it on it's own but using the "Call" function at the end of "GetWebData", it doens't seem to trim anything else but the 1st cell, "D9" in this case.
Also, the Trimed Range (column D) in the "WebDrop" worksheet is part of a Vlookup, cell T9 =VLOOKUP(D9,Air!$A$2:$K$10002,8,FALSE), so the data must be trimed for the Vlookup to function. Once T9, T10, T2000 are done Vlookin-up only then should my third macro activate.
My 3rd macro, "CopyData" would copy the specified fields from sheet "WebDrop" to my final clean cut "DCC" sheet.
Now:
A) can I alternate my vlookup the work without using the "TrimRange" macro
B) can I built my Vlookup as part of a macro?
As it is, T9 to T2000 all contain the Vlookup formula stated above.
C) Any ideas how to clean / tweak these macros?
Thanks in advance.
Cheers,
Sprucy
-----------------------
Sub III_GetWebData()
'
' DOF Macro
' Macro recorded 11/20/2005 by
'Open site if it requires a PassWord Model or field input validation
Dim ie As Object
Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = True
'Go to this Web Page:
ie.Navigate "http://Private.Intranet.sorry"
'Check for good connection to web page loop!
Do
If ie.ReadyState = 4 Then
ie.Visible = False
Exit Do
Else
DoEvents
End If
Loop
'Wait for window to open!
Application.Wait (Now + TimeValue("0:00:02"))
'MsgBox "Done"
ie.Visible = True
'Send date based on Cell A1!
SendKeys "{TAB}", True
SendKeys "{TAB}", True
'May need additional SendKeys as needed?
'Determine by the actual key-stroks needed!
SendKeys [a1].Value, True
SendKeys "{TAB}", True
SendKeys "{ENTER}", True
Application.Wait (Now + TimeValue("0:00:02"))
With ie
.Visible = True
DoEvents
.ExecWB 17, 2
.ExecWB 12, 2
Sheet2.Paste Sheets("WebDrop").Range("A1")
End With
Application.Wait (Now + TimeValue("0:00:01"))
ie.Quit
'Added WebDrop!
Range("WebDrop!H2").Select
Call IV_TrimRange
End Sub
-----------------------------
Sub IV_TrimRange()
'
' TrimRange Macro
' Macro recorded 11/15/2005 by
Dim WorkRange As Range
Set WorkRange = Range("WebDrop!D9:D" & Range("D65536").End(xlUp).Row)
For Each Cell In WorkRange
If Cell.Value = "" Then
GoTo Next1
ElseIf IsNumeric(Cell.Value) Then
Cell.Value = Cell.Value * 1
Else
Cell.Value = Trim(Cell.Value)
End If
Next1:
Next Cell
'Application.Wait (Now + TimeValue("0:00:20"))
'Tried increasing the time to let the "triming" finish.
Call V_CopyData
End Sub
--------------------------------------
Sub V_CopyData()
'Application.Wait (Now + TimeValue("0:00:06"))
'Same as above, tweaking the time frame...not working!
'Copies Web results from "WebDrop" to "DCC" as values only
Sheets("WebDrop").Select
Range("a9:g65536").Copy
Sheets("DCC").Range("a4").PasteSpecial Paste:=xlPasteAll, Operation:=xlPasteSpecialOperationNone, SkipBlanks:=False, Transpose:=False
'Column T values are based VLOOKUP formula
Range("T9:T65536").Select
Selection.Copy
Sheets("DCC").Select
Range("J4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Sheets("DCC").Range("H2").Select
End Sub
-------------------------------