Sorting Data Question 2 Part

[Seldrich]

Part 1:

Ok so I am using this VBA

Private Sub Copy1()

Range("A4", Range("A4").End(xlDown)).Select
Selection.Copy
Sheets("Test Sheet 2").Select
Range("A6").Select
ActiveSheet.Paste
Sheets("Test Sheet").Select

I am trying to get data from multiple columns in the export sheet (Test Sheet) to copy and paste to a new sheet (Test Sheet 2). This script works well, but the part that kills me is that i need 8 columns of data. These are Columns a,b,d,h,l,m,n,t. Is there a way to consoludate this or will i simply have to rinse repeat this code modifing the range?

Part 2:

After this data is copy and pasted onto the "test Sheet 2", I am correcting a numbers displayed as text error that orignates from the first export. Here is the Code.

Private Sub Correct_Text_asnumbers()

For Each c In Range("A:G")
If c = "" Then GoTo nextc
If IsNumeric(c) Then
c.Value = c.Value * 1
c.NumberFormat = "general"
End If
nextc:
Next c
End Sub

It works But it gets hung up for about 30 seconds before it ends. Any Tips to prevent this hang up?

Thanks guys!

 

[alansidman]

Columns a,b,d,h,l,m,n,t.

Are each of these columns of data the same length, ie. do they all have data to same last row?

 

[Seldrich]

Are each of these columns of data the same length, ie. do they all have data to same last row?

Yes all data will end in the same row, but which row they end in changes.

 

[alansidman]

Try this for your copy method:

Option Explicit


Sub CopyM()


Dim w1 As Worksheet
Set w1 = Sheets("Test Sheet2")
Dim w2 As Worksheet
Set w2 = Sheets("Test Sheet")
Dim lr As Long
lr = w1.Range("A" & Rows.Count).End(xlUp).Row
Dim BigRng As Range
Set BigRng = Application.Union(w1.Range("A4:A" & lr), w1.Range("B4:B" & lr), w1.Range("D4:D" & lr), _
    w1.Range("H4:H" & lr), w1.Range("L4:L" & lr), w1.Range("M4:M" & lr), w1.Range("N4:N" & lr), _
    w1.Range("T4:T" & lr))


BigRng.Copy w2.Range("A6")


End Sub

 

[Seldrich]

Try this for your copy method:

Option Explicit


Sub CopyM()


Dim w1 As Worksheet
Set w1 = Sheets("Test Sheet2")
Dim w2 As Worksheet
Set w2 = Sheets("Test Sheet")
Dim lr As Long
lr = w1.Range("A" & Rows.Count).End(xlUp).Row
Dim BigRng As Range
Set BigRng = Application.Union(w1.Range("A4:A" & lr), w1.Range("B4:B" & lr), w1.Range("D4:D" & lr), _
    w1.Range("H4:H" & lr), w1.Range("L4:L" & lr), w1.Range("M4:M" & lr), w1.Range("N4:N" & lr), _
    w1.Range("T4:T" & lr))


BigRng.Copy w2.Range("A6")


End Sub

Ok that worked Great! Seem that w1 and w2 values where transposed. Corrected calue of "test Sheet" and "Test Sheet 2" and it worked like a charm!