PDA

View Full Version : How convert this code to a macro?



محتاج2010
06-08-2011, 03:28 AM
How do I convert this code to a macro?


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim myrange, a, b As Range, rep(150) As Integer
On Error GoTo ErrHandler
Application.EnableEvents = False
rr = Target.Row
x = [B1].Offset(rr - 1, 0)
'=======================================================
Set myrange = Range("B14:B18")
'=======================================================
Range("B14:K18").Interior.Pattern = xlNone
i = 0
'=======================================================
Columns("k").ClearContents
For Each s In myrange
y = s.Value
If y = x Then
i = i + 1
Range("B" & s.Row, "J" & s.Row).Interior.ColorIndex = 42
rep(i) = s.Row
End If
Next s
sum_nj = 0: chg = 0
For j = 1 To i
Set a = Range("H" & rep(j))

For nj = 1 To i
Set b = Range("J" & rep(nj))
Set U = Range("K" & rep(nj))
If b.Value <> a.Value Then chg = 1: b.Interior.ColorIndex = 3
If b.Value <> a.Value Then chg = 1: U.Interior.ColorIndex = 36
Next nj

Next j


'''''''
If chg <> 0 Then
For j = 1 To i
sum_nj = sum_nj + Range("G" & rep(j)).Value
Next j
End If
If sum_nj <> 0 Then Range("k" & rep(1)).Value = sum_nj

ErrHandler:
Application.EnableEvents = True
End Sub

Kenneth Hobs
06-08-2011, 05:10 AM
It already is a macro. Maybe you want to run it multiple times?

Please add VBA code tags when you post code. Structure makes your code easier to read and to troubleshoot. You might want to add Option Explicit so that it will prompt you to Dim your variables. You can add that as an option in the VBE tools.

In a module:
Option Explicit

Sub Macro2010(ByVal Target As Range)
Dim myrange, a, b As Range, rep(150) As Integer
Dim rr As Long, x As Variant, y As Variant, i As Long
Dim s As Range, sum_nj As Variant, chg As Variant, j As Long
Dim nj As Variant, U As Variant

On Error GoTo ErrHandler
Application.EnableEvents = False
rr = Target.Row
x = [B1].Offset(rr - 1, 0)
'=======================================================
Set myrange = Range("B14:B18")
'=======================================================
Range("B14:K18").Interior.Pattern = xlNone
i = 0
'=======================================================
Columns("k").ClearContents
For Each s In myrange
y = s.Value
If y = x Then
i = i + 1
Range("B" & s.Row, "J" & s.Row).Interior.ColorIndex = 42
rep(i) = s.Row
End If
Next s
sum_nj = 0: chg = 0
For j = 1 To i
Set a = Range("H" & rep(j))
For nj = 1 To i
Set b = Range("J" & rep(nj))
Set U = Range("K" & rep(nj))
If b.Value <> a.Value Then chg = 1: b.Interior.ColorIndex = 3
If b.Value <> a.Value Then chg = 1: U.Interior.ColorIndex = 36
Next nj
Next j

'''''''
If chg <> 0 Then
For j = 1 To i
sum_nj = sum_nj + Range("G" & rep(j)).Value
Next j
End If
If sum_nj <> 0 Then Range("k" & rep(1)).Value = sum_nj

ErrHandler:
Application.EnableEvents = True
End Sub


Your worksheet event code is then:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Macro2010 Target
End Sub

محتاج2010
06-08-2011, 06:51 AM
thank u , but I mean another :
I want a macro that combines the quantity of each model and then leave items without details of packing sheet("aa")
can u see my file

محتاج2010
06-09-2011, 01:32 AM
no answer!!!!!!??

محتاج2010
06-11-2011, 01:59 AM
is no any one will help?

Aussiebear
06-11-2011, 04:01 AM
Have you looked at the Excel function "Sumproduct"?

محتاج2010
06-11-2011, 07:22 AM
Yes, but the problem still exists. I want to delete duplicate rows of the column (a) and values added ​​in the rows of duplicate rows of each row to the row that he repeats.
see my file then you will know

Aussiebear
06-12-2011, 01:49 AM
How do we tell what is duplicated? From your data, you have highlighted 4 rows which are not similar. In each case the Style No. is different.

I'm having some difficulty in following your request as the title suggested you wanted to "turn this code into a macro" but it eventually seems that you want to find and delete duplicates and add the value of the duplicated row to the original row. I can only assume you require the Ctn No's to be added.

Can you please take the time to explain in better detail what you are chasing here?

محتاج2010
06-14-2011, 08:41 AM
I changed the code to a macro is not working and what is the problem?



It already is a macro. Maybe you want to run it multiple times?

Please add VBA code tags when you post code. Structure makes your code easier to read and to troubleshoot. You might want to add Option Explicit so that it will prompt you to Dim your variables. You can add that as an option in the VBE tools.

In a module:
Option Explicit

Sub Macro2010(ByVal Target As Range)
Dim myrange, a, b As Range, rep(150) As Integer
Dim rr As Long, x As Variant, y As Variant, i As Long
Dim s As Range, sum_nj As Variant, chg As Variant, j As Long
Dim nj As Variant, U As Variant

On Error GoTo ErrHandler
Application.EnableEvents = False
rr = Target.Row
x = [B1].Offset(rr - 1, 0)
'=======================================================
Set myrange = Range("B14:B18")
'=======================================================
Range("B14:K18").Interior.Pattern = xlNone
i = 0
'=======================================================
Columns("k").ClearContents
For Each s In myrange
y = s.Value
If y = x Then
i = i + 1
Range("B" & s.Row, "J" & s.Row).Interior.ColorIndex = 42
rep(i) = s.Row
End If
Next s
sum_nj = 0: chg = 0
For j = 1 To i
Set a = Range("H" & rep(j))
For nj = 1 To i
Set b = Range("J" & rep(nj))
Set U = Range("K" & rep(nj))
If b.Value <> a.Value Then chg = 1: b.Interior.ColorIndex = 3
If b.Value <> a.Value Then chg = 1: U.Interior.ColorIndex = 36
Next nj
Next j

'''''''
If chg <> 0 Then
For j = 1 To i
sum_nj = sum_nj + Range("G" & rep(j)).Value
Next j
End If
If sum_nj <> 0 Then Range("k" & rep(1)).Value = sum_nj

ErrHandler:
Application.EnableEvents = True
End Sub


Your worksheet event code is then:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Macro2010 Target
End Sub

Aussiebear
06-14-2011, 03:46 PM
What is the error message and to which line does it refer to?

محتاج2010
06-16-2011, 03:00 AM
or all, has helped some of the brothers; and this code

Sub Macro2010()

With ActiveSheet
Application.ScreenUpdating = False
Dim myrange, A, b As Range, rep(100) As Integer
FRI = Range("A10").Value + 12
Set myrange = Range("B13", "B" & FRI)
Range("B" & 13, "J" & FRI + 1).Interior.Pattern = xlNone: [A:A].Interior.Pattern = xlNone
[j:j].ClearContents
For Each f In myrange
SUM_NJ = 0
i = 0
For Each s In myrange
If s.Value = f.Value Then
i = i + 1
rep(i) = s.Row
Range("j" & s.Row).Interior.ColorIndex = 4
SUM_NJ = SUM_NJ + Range("G" & rep(i)).Value
If Range("G" & rep(1)).Value > 0 Then Range("A" & s.Row, "i" & s.Row).Interior.ColorIndex = 36 ' تلوين عند وجود ارقام
End If
Next s
If SUM_NJ <> 0 Then
Range("J" & rep(1)).Value = SUM_NJ
For K = 2 To i
Range("a" & rep(K), "i" & rep(K)).Interior.ColorIndex = 3
Next K

End If

Next f
End With

Dim h As Long
Lastrow = Cells(Rows.Count, "J").End(xlUp).Row + 100
For h = Lastrow To 13 Step -1
With ActiveSheet
If .Cells(h, "J").Value2 = Empty Then
.Rows(h).Delete
Range("G13:G100").Value = Range("J13:J100").Value
End If
End With
Next h
end sub