Hello,
I have a code for deleting unnecessary data in my excel tables (all in same sheet):
All criteria are in same column, and first column number is 4 ("D") and other columns differ every 86 columns (for example: second column is 4+86= 90 column "CL"). There are 31 tables in total, so 31 columns.
Can you help me to simplify my huge code? I tried to create loop for all those columns, didn't worked :/
I have a code for deleting unnecessary data in my excel tables (all in same sheet):
VBA Code:
Sub delete_data()
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.DisplayStatusBar = False
ActiveSheet.DisplayPageBreaks = False
Application.Calculation = xlCalculationManual
Dim cell As Range
Dim rng As Range
'delete first site of data1
With ActiveSheet
For Each cell In .Range("D1:D263,CL1:CL263,FT1:FT263,JB1:JB263,MJ1:MJ263,PR1:PR263,SZ1:SZ263,WH1:WH263,ZP1:ZP263,ACX1:ACX263,AGF1:AGF263,AJN1:AJN263,AMV1:AMV263,AQD1:AQD263,ATL1:ATL263,AWT1:AWT263,BAB1:BAB263")
If cell.Value = "criteria No. 1" Then
Set rng = cell
.Range(Cells(rng.Row - 1, rng.Column + 3), Cells(rng.Row + 3, rng.Column + 62)).Value = ""
End If
Next cell
End With
'delete first site of data2
With ActiveSheet
For Each cell In .Range("BDJ1:BDJ263,BGR1:BGR263,BJZ1:BJZ263,BNH1:BNH263,BQP1:BQP263,BTX1:BTX263,BXF1:BXF263,CAN1:CAN263,CDV1:CDV263,CHD1:CHD263,CKL1:CKL263,CNT1:CNT263,CRB1:CRB263,CUJ1:CUJ263")
If cell.Value = "criteria No. 1" Then
Set rng = cell
.Range(Cells(rng.Row - 1, rng.Column + 3), Cells(rng.Row + 3, rng.Column + 62)).Value = ""
End If
Next cell
End With
'delete second site of data1
With ActiveSheet
For Each cell In .Range("D1:D263,CL1:CL263,FT1:FT263,JB1:JB263,MJ1:MJ263,PR1:PR263,SZ1:SZ263,WH1:WH263,ZP1:ZP263,ACX1:ACX263,AGF1:AGF263,AJN1:AJN263,AMV1:AMV263,AQD1:AQD263,ATL1:ATL263,AWT1:AWT263,BAB1:BAB263")
If cell.Value = "criteria No. 2" Then
Set rng = cell
.Range(Cells(rng.Row + 1, rng.Column + 3), Cells(rng.Row + 6, rng.Column + 62)).Value = ""
End If
Next cell
End With
'delete second site of data2
With ActiveSheet
For Each cell In .Range("BDJ1:BDJ263,BGR1:BGR263,BJZ1:BJZ263,BNH1:BNH263,BQP1:BQP263,BTX1:BTX263,BXF1:BXF263,CAN1:CAN263,CDV1:CDV263,CHD1:CHD263,CKL1:CKL263,CNT1:CNT263,CRB1:CRB263,CUJ1:CUJ263")
If cell.Value = "criteria No. 2" Then
Set rng = cell
.Range(Cells(rng.Row + 1, rng.Column + 3), Cells(rng.Row + 6, rng.Column + 62)).Value = ""
End If
Next cell
End With
'copy/paste third site of data1
With ActiveSheet
For Each cell In .Range("D1:D263,CL1:CL263,FT1:FT263,JB1:JB263,MJ1:MJ263,PR1:PR263,SZ1:SZ263,WH1:WH263,ZP1:ZP263,ACX1:ACX263,AGF1:AGF263,AJN1:AJN263,AMV1:AMV263,AQD1:AQD263,ATL1:ATL263,AWT1:AWT263,BAB1:BAB263")
If cell.Value = "criteria No. 2" Then
Set rng = cell
Range("D1:BK1").Copy
.Range(Cells(rng.Row, rng.Column + 3), Cells(rng.Row, rng.Column + 62)).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End If
Next cell
End With
'copy/paste third site of data2
With ActiveSheet
For Each cell In .Range("BDJ1:BDJ263,BGR1:BGR263,BJZ1:BJZ263,BNH1:BNH263,BQP1:BQP263,BTX1:BTX263,BXF1:BXF263,CAN1:CAN263,CDV1:CDV263,CHD1:CHD263,CKL1:CKL263,CNT1:CNT263,CRB1:CRB263,CUJ1:CUJ263")
If cell.Value = "criteria No. 2" Then
Set rng = cell
Range("D1:BK1").Copy
.Range(Cells(rng.Row, rng.Column + 3), Cells(rng.Row, rng.Column + 62)).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End If
Next cell
End With
'copy/paste fourth site of data1
With ActiveSheet
For Each cell In .Range("D1:D263,CL1:CL263,FT1:FT263,JB1:JB263,MJ1:MJ263,PR1:PR263,SZ1:SZ263,WH1:WH263,ZP1:ZP263,ACX1:ACX263,AGF1:AGF263,AJN1:AJN263,AMV1:AMV263,AQD1:AQD263,ATL1:ATL263,AWT1:AWT263,BAB1:BAB263")
If cell.Value = "criteria No. 3" Then
Set rng = cell
Range("D2:BK2").Copy
.Range(Cells(rng.Row, rng.Column + 3), Cells(rng.Row, rng.Column + 62)).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End If
Next cell
End With
'copy/paste fourth site of data2
With ActiveSheet
For Each cell In .Range("BDJ1:BDJ263,BGR1:BGR263,BJZ1:BJZ263,BNH1:BNH263,BQP1:BQP263,BTX1:BTX263,BXF1:BXF263,CAN1:CAN263,CDV1:CDV263,CHD1:CHD263,CKL1:CKL263,CNT1:CNT263,CRB1:CRB263,CUJ1:CUJ263")
If cell.Value = "criteria No. 3" Then
Set rng = cell
Range("D2:BK2").Copy
.Range(Cells(rng.Row, rng.Column + 3), Cells(rng.Row, rng.Column + 62)).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End If
Next cell
End With
'Delete fifth site of data1
With ActiveSheet
For Each cell In .Range("D1:D263,CL1:CL263,FT1:FT263,JB1:JB263,MJ1:MJ263,PR1:PR263,SZ1:SZ263,WH1:WH263,ZP1:ZP263,ACX1:ACX263,AGF1:AGF263,AJN1:AJN263,AMV1:AMV263,AQD1:AQD263,ATL1:ATL263,AWT1:AWT263,BAB1:BAB263")
If cell.Value = "criteria No. 4" Then
Set rng = cell
.Range(Cells(rng.Row, rng.Column + 3), Cells(rng.Row, rng.Column + 62)).Value = ""
End If
Next cell
End With
'Delete fifth site of data2
With ActiveSheet
For Each cell In .Range("BDJ1:BDJ263,BGR1:BGR263,BJZ1:BJZ263,BNH1:BNH263,BQP1:BQP263,BTX1:BTX263,BXF1:BXF263,CAN1:CAN263,CDV1:CDV263,CHD1:CHD263,CKL1:CKL263,CNT1:CNT263,CRB1:CRB263,CUJ1:CUJ263")
If cell.Value = "criteria No. 4" Then
Set rng = cell
.Range(Cells(rng.Row, rng.Column + 3), Cells(rng.Row, rng.Column + 62)).Value = ""
End If
Next cell
End With
'othe data reset
Range("D49").Value = "MT"
Range("D50").Value = ""
Range("D51").Value = ""
Range("D52").Value = "L-"
Range("D53").Value = "230"
Range("D55").Value = "100 mm"
Range("B47").Activate
Application.Goto ActiveCell, Scroll:=True
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.DisplayStatusBar = True
ActiveSheet.DisplayPageBreaks = True
Calculate
Application.Calculation = xlCalculationAutomatic
End Sub
All criteria are in same column, and first column number is 4 ("D") and other columns differ every 86 columns (for example: second column is 4+86= 90 column "CL"). There are 31 tables in total, so 31 columns.
Can you help me to simplify my huge code? I tried to create loop for all those columns, didn't worked :/