PDA

View Full Version : [SOLVED] Issue with button



ell_
01-22-2018, 01:33 AM
Hi, all

I have assigned a button to run this code:


Sub CombineAll()
'========================================================================== ================
'Sheet: Summary
Sheets("Summary").Range("AL23:AN120").ClearContents
Dim p As Long, lp As Long, rnge As Range
Application.ScreenUpdating = False
With Worksheets("Summary")
With .Range("B8:AI" & Cells(Rows.Count, "B").End(xlUp).Row)
.AutoFilter 24, "<>"
End With
p = .Range("B9", .Range("B" & Rows.Count).End(xlUp)).SpecialCells(12).Row
lp = .Cells(Rows.Count, "B").End(xlUp).Row
Set rnge = Union(.Range("B" & p & ":C" & lp), .Range("AI" & p & ":AI" & lp))
rnge.Copy
.AutoFilterMode = False
.Range("AL23").PasteSpecial xlPasteValues
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
'========================================================================== ====================
'Sheet: DTE
Sheets("DTE").Range("A2:G200").ClearContents
Sheets("DTE").Range("A2:G200").Interior.ColorIndex = xlNone
Dim Shop As String
Dim Shop2 As String
Application.ScreenUpdating = False
Shop = Sheets("DTE").Range("K2")
Shop2 = Sheets("DTE").Range("M2")
With Sheets("DTE_Raw")
With .Cells(1).CurrentRegion
.AutoFilter 1, Shop
.AutoFilter 3, Shop2
.Offset(1, 0).SpecialCells(12).Copy Sheets("DTE").Range("A2")
End With
.AutoFilterMode = False
End With
Dim rw As Long, x As Long, llr As Long
llr = Cells(Rows.Count, 1).End(xlUp).Row
For x = 1 To llr
If Sheets("DTE").Cells(x, 1) = Sheets("DTE").Range("K2") Then rw = rw + 1
If rw = 6 Then
Range("A1:G1").Copy
Cells(x, 1).Insert
rw = 0
End If
Next

Sheets("DTE").Range("A1:G200").Borders.LineStyle = xlContinuous
Sheets("DTE").Columns("A:G").HorizontalAlignment = xlCenter
Sheets("DTE").Range("A2:G200").WrapText = True
Application.ScreenUpdating = True
'========================================================================== ========================
Sheets("Alarm Management").Range("A1:C15").Columns.AutoFit
'========================================================================== ========================
'Sheet: PEROutput
Sheets("PEROutput").Range("B9:AN150").ClearContents
Dim r As Long, lr As Long, rng As Range
Application.ScreenUpdating = False
With Sheets("PER_All")
With .Range("B8:AI" & Cells(Rows.Count, "B").End(xlUp).Row)
.AutoFilter 34, "<>"
End With
r = .Range("B9", .Range("B" & Rows.Count).End(xlUp)).SpecialCells(12).Row
lr = .Cells(Rows.Count, "B").End(xlUp).Row
Set rng = .Range("B" & r & ":AI" & lr)
rng.Copy
.AutoFilterMode = False
Sheets("PEROutput").Range("B9").PasteSpecial xlPasteValues
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub



But the button always skips this part:

Dim rw As Long, x As Long, llr As Long
llr = Cells(Rows.Count, 1).End(xlUp).Row
For x = 1 To llr
If Sheets("DTE").Cells(x, 1) = Sheets("DTE").Range("K2") Then rw = rw + 1
If rw = 6 Then
Range("A1:G1").Copy
Cells(x, 1).Insert
rw = 0
End If
Next


May I know if there's any reason to that? I have been assigning the macro repeatedly but the same thing happens.

paulked
01-22-2018, 03:51 AM
Do you need to reference the sheet for llr? ie llr = Sheets("DTE").Cells(Rows.Count, 1).End(xlUp).Row

mana
01-22-2018, 03:58 AM
Delete

mana
01-22-2018, 04:23 AM
Dim i As Long

With Sheets("DTE").Range("A1").CurrentRegion.Resize(, 7).Rows
For i = 7 To .Count Step 6
.Item(1).Copy
.Item(i).Insert
Next
End With


Application.CutCopyMode = False

ell_
01-22-2018, 07:16 AM
Thank you to both of you! I have been looking at the code for hours, trying to configure my mistake. Have a lovely day :)