New to VBA

[lafinca47]

Hi,

I'm new to VBA and this task is beyond my knowledge of VBA so any
advice would be great. I have a list of data set out like so in
worksheet 3:


1 A N
1 B N
1 C N
1 D N
1 E Y
1 F Y
1 G N
2 A N
2 B N
2 C Y
2 D Y
2 E N
2 F N
2 G N
3 A Y
3 B Y
3 C N
3 D N
3 E N
3 F N
3 G N


I want to create a macro that will look down colunm A and if value
below matches take the value in column C and paste it into worksheet 1
and then do the same again but paste the result in column C next to the

last value each time, and continue down until the value in column A
changes then do the same again until the value changes etc.


The end result I'm trying to achieve would look something like so:


A B C D E F G
1 N N N N Y Y N
2 N N Y Y N N N
3 Y Y N N N N N


The reason I'm doing this is because with the data vertical I have
close to 40,000 rows but by sorting it horizontally I will only be
dealing with around 2,000 rows.


Any help on this would be much aprieciated as I seemed to have spent
ages in VBA not really getting any where.


Thanks in advance for your help.

 

[Guest]

Hello,

I use the same format for my data, and I use pivot-tables/charts. In this
way you can choose wether you want to use VBA or not. You can even program
your pivots in VBA.

Greets,
Sven M.

 

[Guest]

Hi,
Try this: input Sheet1, output Sheet2

Dim ws1 As Worksheet, ws2 As Worksheet
Dim r As Long, rr As Long, lastrow As Long
Dim n As Integer

Set ws1 = Worksheets("sheet1") '<=== change as required
Set ws2 = Worksheets("sheet2")

With ws1
lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
r = 1
rr = 2
Do
n = Application.CountIf(Range("A:A"), .Cells(r, "A"))
ws2.Cells(rr, "A") = .Cells(r, "A")
.Cells(r, "C").Resize(n, 1).Copy
ws2.Cells(rr, "B").Resize(1, n).PasteSpecial Paste:=xlPasteAll,
Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
r = r + n
rr = rr + 1
Loop Until r > lastrow
End With

 

[Bob Phillips]

Sub Test()
Dim iLastRow As Long
Dim i As Long
Dim ipos As Long

Rows(1).Insert
Columns(2).Delete
Range("B1").Value = "A"
Range("C1").Value = "B"
Range("D1").Value = "C"
Range("E1").Value = "D"
Range("F1").Value = "E"
Range("G1").Value = "F"
Range("H1").Value = "G"
Range("I1").Value = "H"
iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
For i = iLastRow To 2 Step -1
If Cells(i, "A").Value = Cells(i - 1, "A").Value Then
Cells(i, "B").Resize(1, 100).Copy Cells(i - 1, "C")
Rows(i).Delete
End If
Next i

End Sub



--
HTH

Bob Phillips

(remove nothere from email address if mailing direct)

 

[lafinca47]

Thanks for your help on this guys but I'm still struggling, I'm
thinking that I may be trying to do this with too much detail. I
thought of a way of simplfying it and was wondering if there was of
just copying every 10 cells in a column and transposing them it rows
under each other?

Once again thanks for you help

 

[Bob Phillips]

What problem are you getting?

--
HTH

Bob Phillips

(remove nothere from email address if mailing direct)

 

[lafinca47]

Sorry Bob it wasjust my lack of experience with VBA it works perfectly
thanks just need to make a few adjustments to make it fit my
spreadsheet.

However I have now decided to add something else in to the code you
gave me.

Basically as I have so much data when I run the Macro the screen looks
like it freezes up and I know for the people that will be using it they
will think that it has crashed and will try to shut it down. So I went
searching for a way to add in a progress bar so as the Macro is running
it will show a percentage complete which will show that the spreadsheet
as not crashed but is still calculating.

I wnt onto the groups and found a macro for a progress bar using a
userform, however I'm struggling to wrap that piece of code around my
original piece of code.

If anyone could help out that would be great as I could really do with
it. Hopefully its just a case of jumbling it around to make it work.

Here it is....

Sub Form()
' The UserForm1_Activate sub calls Main
UserForm1.LabelProgress.Width = 0
UserForm1.Show
End Sub

Sub Test ()

Dim iLastRow As Long
Dim i As Long
Dim ipos As Long
Dim PctDone As Single
Dim r As Integer
Dim Cell As Object
Dim Count As Integer


Count = 0
For Each Cell In Selection
Count = Count + 1
For i = iLastRow To 2 Step -1
If Cells(i, "C").Value = Cells(i - 1, "C").Value Then
Cells(i, "S").Resize(1, 100).Copy Cells(i - 1, "T")
Rows(i).Delete
End If
Next i
Next Cell
For r = 1 To Cell
Count = Count + 1
PctDone = Count / Cell
With UserForm1
.FrameProgress.Caption = Format(PctDone, "0%")
.LabelProgress.Width = PctDone * (.FrameProgress.Width -
10)
End With
' The DoEvents statement is responsible for the form updating
DoEvents
Next r
Unload UserForm1

End Sub