macros

Joined
Dec 6, 2011
Messages
1
Reaction score
0
can anyone help me with this problem please I have coloured the problem code yellow


Sub Manual_Start()
Dim reportdate As Range
' Manual_Start()
' unhide sheets
Sheets("All_Data").Visible = True
Sheets("L6_Filter_Data").Visible = True
' clear data from All_Data worksheet
'
Sheets("All_Data").Select
Application.ScreenUpdating = False
Columns("A:AQ").Select
Selection.Clear
' get yesterday's date for the filter
'
Set reportdate = Range("AS2")

' retrieve the data from the lotus notes database
'
With ActiveSheet.QueryTables.Add(Connection:=Array(Array( _
"ODBC;DRIVER={Lotus NotesSQL Driver (*.nsf)};Database=Prodman\Prodman_LINE6.nsf;Server=10.0.0.5;UserName=;EncryptPWD=;MaxSubquery=20;MaxStmtLen=" _
), Array( _
"4096;MaxRels=20;MaxVarcharLen=254;KeepTempIdx=1;MaxLongVarcharLen=512;ShowImplicitFlds=0;MapSpecialChars=1;ThreadTimeout=60;" _
)), Destination:=Range("A1"))
.CommandText = Array("SELECT * " & _
"FROM Fails_Analysis___Parts" _
)
.Name = "Query from prodman"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = True
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.Refresh BackgroundQuery:=False
End With

ActiveWindow.SmallScroll Down:=-18

'****************** LINE 6 ***************************
'
' process the data for line 6
'
Call Line_6_Data

' update the pivot table data

Sheets("Pivot Data").Select
Range("A4").Select
ActiveSheet.PivotTables("YieldPivot").PivotCache.Refresh
Range("B3").Select

' hide sheets
Sheets("All_Data").Visible = False
Sheets("L6_Filter_Data").Visible = False

' close the workbook where the macro is running
'
' ThisWorkbook.Close savechanges:=False

End Sub

Sub Clear_Empty_Rows()
Dim NullRange As Range
Set NullRange = Nothing
For I = 1 To ActiveSheet.UsedRange.Rows.Count
If Range("A" & I).Value = "" Then 'If cell in column A (for simplicity) is empty, then add to NullRange.
If NullRange Is Nothing Then 'If NullRange were non-empty to start, this If could be removed leaving the Else action as the only one to perform.
Set NullRange = (Cells(I, 1))
Else
Set NullRange = Union(NullRange, Cells(I, 1))
End If
End If
Next
If Not (NullRange Is Nothing) Then
NullRange.EntireRow.Clear 'Clear the rows which satisfy the condition.
End If
End Sub
Sub Line_6_Data()
' clear data from L6_Filter_Data worksheet
'
Sheets("L6_Filter_Data").Select
Application.ScreenUpdating = False
Columns("A:AQ").Select
Selection.Clear

Range("B4").Select

' sort All_Data to retreive all rows with yesterday's date and
' place them in the L6_Filter_Data worksheet
'
Sheets("All_Data").Range("A1:AQ9999").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("All_Data").Range("AS1:AT2"), CopyToRange:=Range("A1") _
, Unique:=False

' convert the data on the L6_Filter_Data sheet from text to numbers by multiplying
' the data by 1 (digit stored in cell AC1)
'
Range("AS1").Select
ActiveCell.FormulaR1C1 = "1"
Range("AS1").Select
Selection.Copy
Range("P2:AQ999").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlMultiply, _
SkipBlanks:=False, Transpose:=False
Range("AS1").Select
Application.CutCopyMode = False
Selection.ClearContents

' clear the unpopulated rows on the L6_Filter_Data worksheet in order to remove
' the unneccesary zeroes created above
'
Call Clear_Empty_Rows

' select the page headings from All_Data sheet and add them to the L6_Filter_Data sheet
'
Sheets("All_Data").Select
Range("AV1:CI1").Select
Selection.Copy
Sheets("L6_Filter_Data").Select
Range("A1").Select
ActiveSheet.Paste

End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top