Help modifying code

[toblju]

I have raw data in Sheet1 and a makro that creates new data in Sheet2.

Everything except one thing works as I want. The only thing is that the data in the second column for the moment is going from 1 to 4552 (all rows). I would like it to be from 1 to 4, from 1 to 4 (1,2,3,4,1,2,3,4,1,2,3 and so on).

Is there anyone out there who could help. My knowledge in VBA is too short...
Pls see enclosed file: 8625
Tobias.

[patel]

Attach please a file with current situation and desired

[parttime_guy]

Hi toblju,

Attached is the solution

Happy Excelling :hi:

Regards

[snb]

Use:


Sub snb()
[D1:D5000] = [if(A1:A5000="","",mod(row(1:5000)-1,4)+1)]
End Sub


To get the results in column B:


Sub snb()
[B1:B5000] = [if(A1:A5000="","",mod(row(1:5000)-1,4)+1)]
End Sub

[Bob Phillips]

Sub abc()
Dim a() As Variant, b As Variant, i As Long, ii As Long, n As Long

b = Sheet1.Range("A1").CurrentRegion
ReDim a(1 To UBound(b) * UBound(b, 2), 1 To 3)

For i = 1 To UBound(b)
For ii = 2 To UBound(b, 2)
If b(i, ii) <> "xxxx" Then
n = n + 1
a(n, 1) = b(i, 1)
a(n, 3) = b(i, ii)
End If
Next ii, i

With Sheet2
.Range("A1").Resize(n, 3) = a
With .Range("B1").Resize(n)
.Formula = "=COUNTIF($A$1:A1,A1)"
.Value = .Value
End With
End With
End Sub

[GTO]

Greetings toblju,

Next ii, i
I may be experiencing 'brain fallout' (that is, forgetting), but I don't recall ever seeing that manner of nesting the loops. Whilst I personally find it a bit harder to read, it is always nice to learn something new, so thank you :-)

FWIW, here is one more:
Sub abc_1()
Dim a() As Variant, b As Variant, i As Long, ii As Long, n As Long, j As Long, k As Long

b = Sheet1.Range("A1").CurrentRegion
ReDim a(1 To UBound(b) * UBound(b, 2), 1 To 3)

For i = 1 To UBound(b)
For ii = 2 To UBound(b, 2)
If b(i, ii) <> "xxxx" Then

n = n + 1
a(n, 1) = b(i, 1)

j = n - 1
k = 1
Do While j > 0
If a(j, 1) = a(n, 1) Then
k = k + 1
j = j - 1
Else
Exit Do
End If
Loop

a(n, 2) = k
a(n, 3) = b(i, ii)
End If
Next ii, i

Sheet2.Range("a1").Resize(n, 3) = a
End Sub

I hope you noticed that XLD typed the variables to Longs that could be. I mentioned, only as you mentioned being newer to vba.

Happy coding!

Mark

[parttime_guy]

Dear Guru's of vbaexpress,

Just a small suggestion to xld's code (insert a line)

With Sheet2
.Range("A1").Resize(n, 3) = a


insert line

With Sheet2
Sheet2.Cells.Clear
.Range("A1").Resize(n, 3) = a


as once you run the code again with less data the old data still remains.

Regards :friends: :bow: