TPS Checker


Application.ScreenUpdating = False
ActiveSheet.Cells.Interior.Color = xlNone

x = 4
Z = 3

For n = 1 To 2

Sheets("TPS_IMPORT").Select
With ActiveSheet.QueryTables.Add(Connection:="TEXT;F:\" & n & ".txt", Destination:= _
Range("$A$1"))
.Name = "1"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 850
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(2)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With

'Lastrow in Checker Col A
With Worksheets("Checker")
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With

Worksheets("Checker").Select

Cells(2, n + x).Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-3]<>"""",COUNTIF(TPS_IMPORT!C[-" & x & "],Checker!RC[-" & Z & "]),0)"
Selection.AutoFill Destination:=Range(Cells(2, n + x), Cells(lastrow, n + x)), Type:=xlFillDefault
x = x + 1

Cells(2, n + x).Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-3]<>"""",COUNTIF(TPS_IMPORT!C[-" & x & "],Checker!RC[-" & Z & "]),0)"
Selection.AutoFill Destination:=Range(Cells(2, n + x), Cells(lastrow, n + x)), Type:=xlFillDefault
x = x + 1

Cells(2, n + x).Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-3]<>"""",COUNTIF(TPS_IMPORT!C[-" & x & "],Checker!RC[-" & Z & "]),0)"
Selection.AutoFill Destination:=Range(Cells(2, n + x), Cells(lastrow, n + x)), Type:=xlFillDefault

Z = Z + 3

Next n

For r = 2 To lastrow

For C = 5 To 46

If C = 5 Or C = 8 Or C = 11 Or C = 14 Or C = 17 Or C = 20 Or C = 23 Or C = 26 Or C = 29 Or C = 32 Or C = 35 Or C = 38 Or C = 41 Or C = 44 Then x = 2
If C = 6 Or C = 9 Or C = 12 Or C = 15 Or C = 18 Or C = 21 Or C = 24 Or C = 27 Or C = 30 Or C = 33 Or C = 36 Or C = 39 Or C = 42 Or C = 45 Then x = 3
If C = 7 Or C = 10 Or C = 13 Or C = 16 Or C = 19 Or C = 22 Or C = 25 Or C = 28 Or C = 31 Or C = 34 Or C = 37 Or C = 40 Or C = 43 Or C = 46 Then x = 4

If ActiveSheet.Cells(r, C) = 1 Then ActiveSheet.Cells(r, x).Interior.Color = 255

Next C

Next r

Datanology