This code works, but it's a seven minute ride.

1858 index numbers listed in column A.

In range C1 to EJ95 I need to find them and move them down 1 row and left 1 column. Each index number appears only once in this range.

Per usual, I struggle making array code work for me.

Thanks,
Howard


Sub ReDoData()
Dim c As Range, spNum As Range
Application.ScreenUpdating = False

With Range("C1:EJ950")
.UnMerge
End With

For Each c In Worksheets("Orginal List").Range("A1:A1858")

Set spNum = Sheets("Orginal List").Range("C1:EJ950") _
.Find(What:=c, _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)

If Not spNum Is Nothing Then

spNum.Cut spNum.Offset(1, -1)

End If

Next

Application.ScreenUpdating = True
End Sub

Typo, EJ950

In range C1 to EJ95 I need to find them...

H

Hi Howard,

Am Sun, 29 Mar 2015 03:36:27 -0700 (PDT) schrieb L. Howard:

1858 index numbers listed in column A.

are the numbers in A1:A1858 unique?

In range C1 to EJ95 I need to find them and move them down 1 row and left 1 column. Each index number appears only once in this range.

Do all numbers from column A occur in C1:EJ950?


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

Hi Howard,

Am Sun, 29 Mar 2015 03:36:27 -0700 (PDT) schrieb L. Howard:

This code works, but it's a seven minute ride.

I tried several ways. The fastest one was this way:

Sub ReDoData()
Dim varCheck As Variant, varTmp As Variant
Dim myDic As Object
Dim i As Long

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set myDic = CreateObject("Scripting.Dictionary")

With Sheets("Orginal List")
.Range("C1:EJ950").UnMerge
.Range("XFD1").FormulaArray = _

"=IFERROR(ADDRESS(MIN(IF($C$1:$EJ$950=A1,ROW($1:$9 50))),MIN(IF($C$1:$EJ$950=A1,COLUMN(C:EJ)))),"""") "
.Range("XFD1").AutoFill Destination:=.Range("XFD1:XFD1858")
.Range("XFD1:XFD1858").Calculate

varTmp = .Range("XFD1:XFD1858")
.Columns("XFD").ClearContents

For i = 1 To UBound(varTmp)
myDic(varTmp(i, 1)) = varTmp(i, 1)
Next

varCheck = myDic.items

For i = 1 To UBound(varCheck)
If varCheck(i) < "" Then
.Range(varCheck(i)).Cut .Range(varCheck(i)).Offset(1, -1)
End If
Next
End With
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

Hi Claus,

Thanks for taking the time to do the code.

Changed this

For i = 1 To UBound(varCheck)

To this

For i = 0 To UBound(varCheck)

It was missing the first index number.

Seems to work well.
Much faster than the loop of course.

The list in column A are unique values, and I believe they all occur in C1:HQ950. (a little range change, I was missing some data)


The worksheet of data is a horrible layout, although it makes sense to the user as it is a "map" of locations of equipment placed in a solar panel field. So the "blocks" of data on the sheet are in the same relation to each other as they are in the field, on the ground in real life.

Checking results is nearly impossible.

The further problem is transferring the data to a separate sheet to produce a more viewable and verifiable set of data.

The code puts the index number in the left most cell of a row of 22 serial numbers. With two different formats.

Some are like this:

1-1-1-2 x x x x x x x x x x x x x x x x x x x x x x

Some are like this:

1-1-1-3 x x x x x x x x x x x
x x x x x x x x x x x

So there are some index numbers followed by 22 serial numbers (23 cells)

And some index numbers followed by 11 serial numbers in two rows.

On Sheet New List is the goal to list like this.

1-1-1-1 x x x x x x x x x x x x x x x x x x x x x x
1-1-1-2 x x x x x x x x x x x x x x x x x x x x x x
1-1-1-3 x x x x x x x x x x x x x x x x x x x x x x
..
..
etc. for 1800+
..
..
4-14-5-5 x x x x x x x x x x x x x x x x x x x x x x
4-14-5-6 x x x x x x x x x x x x x x x x x x x x x x
4-14-5-7 x x x x x x x x x x x x x x x x x x x x x x

If they were all on a single row, I could do another loop to "find - resize -copy - xlEndUp(2)" to Sheet New List.

I can't figure out how to make a code know if it is working with a single 22 cell range or if it is a two row 12-x-11 cell range.

Howard

Changed this

For i = 1 To UBound(varCheck)

To this

For i = 0 To UBound(varCheck)

And now you're missing the last item...

For

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

Changed this

For i = 1 To UBound(varCheck)

To this

For i = 0 To UBound(varCheck)

And now you're missing the last item...

For

Ignore this...

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

Hi Howard,

Am Sun, 29 Mar 2015 15:28:47 -0700 (PDT) schrieb L. Howard:


For i = 1 To UBound(varCheck)

To this

For i = 0 To UBound(varCheck)

sorry, all other arrays had base 1. So I made this mistake.

The further problem is transferring the data to a separate sheet to produce a more viewable and verifiable set of data.

Do you want to cut matches and insert them offset(1,-1) and also
transfer the matches to a new sheet?
Or what data do you want to transfer? If all values from column A occure
in the range C1:HQ950 you could copy column A and paste only the values.
Then wraptext is false in the new list.
Are some cells merged in the range C1:HQ950? And in column A also?


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

Do you want to cut matches and insert them offset(1,-1) and also
transfer the matches to a new sheet?
Or what data do you want to transfer? If all values from column A occure
in the range C1:HQ950 you could copy column A and paste only the values.
Then wraptext is false in the new list.
Are some cells merged in the range C1:HQ950? And in column A also?


Regards
Claus B.


Do you want to cut matches and insert them offset(1,-1) and also
transfer the matches to a new sheet?

That is exactly the aim. Probably should have said so to start with, but wasn't sure if I was even going to proceed with the first part.

Here is what I have so far, which seems to work for single row data, and the UNION part, I find does not copy two ranges, plus it is a loop which will take forever to run. But I thought I would give it a try.

Here is the transfer part I have, where the ElseIf part does not work.

If Not spNum Is Nothing Then
If spNum.Offset(1, 1) = "" Then
spNum.Resize(1, 23).Copy Sheets("New List").Range("A" & Rows.Count).End(xlUp)(2)

ElseIf spNum.Offset(1, 1) < "" Then

Set rng1 = spNum.Resize(1, 12)
Set rng2 = spNum.Offset(1, 1).Resize(1, 11)

Set rngUnion = Application.Union(rng1, rng2)
rngUnion.Copy Sheets("New List").Range("A" & Rows.Count).End(xlUp)(2)
End If
End If


Are some cells merged in the range C1:HQ950? And in column A also?

Many, many in the range, but not in column A. However the code you provided, dumps the merged cells.

I think I see what you are saying about the transfers. I'll study that some more.

Howard

Hi Howard,

Am Mon, 30 Mar 2015 08:50:29 -0700 (PDT) schrieb L. Howard:

Here is the transfer part I have, where the ElseIf part does not work.

try:

Sub ReDoData()
Dim varCheck As Variant, varTmp As Variant
Dim myDic As Object
Dim rngBig As Range, rngTmp As Range
Dim i As Long, n As Long
Dim st As Double

st = Timer

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set myDic = CreateObject("Scripting.Dictionary")

With Sheets("Orginal List")
.Activate
.Range("A1:HQ1858").Replace what:=Chr(10), replacement:="",
lookat:=xlPart
.Range("A1:HQ1858").Select
With Selection
.WrapText = False
.MergeCells = False
End With

.Range("XFD1").FormulaArray = _

"=IFERROR(ADDRESS(MIN(IF($C$1:$HQ$950=A1,ROW($1:$9 50))),MIN(IF($C$1:$HQ$950=A1,COLUMN(C:HQ)))),"""") "
.Range("XFD1").AutoFill Destination:=.Range("XFD1:XFD1858")
.Range("XFD1:XFD1858").Calculate

varTmp = .Range("XFD1:XFD1858")
.Columns("XFD").ClearContents

For i = 1 To UBound(varTmp)
myDic(varTmp(i, 1)) = varTmp(i, 1)
Next

varCheck = myDic.items

For i = 0 To UBound(varCheck)
If varCheck(i) < "" Then
If Len(.Range(varCheck(i)).Offset(1, 1)) = 0 Then
Sheets("New List").Cells(Rows.Count, 1).End(xlUp)(2) _
.Resize(, 23).Value = .Range(varCheck(i)).Offset(,
1).Resize(, 23).Value
Else
Sheets("New List").Cells(Rows.Count, 1).End(xlUp)(2) _
.Resize(, 12).Value = .Range(varCheck(i)).Resize(,
12).Value
End If
.Range(varCheck(i)).Cut .Range(varCheck(i)).Offset(1, -1)
End If
Next
End With
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
MsgBox Format(Timer - st, "0.000")
End Sub

Or :

Sub ReDoData2()
Dim varCheck As Variant
Dim Tmp, c
Dim i As Long
Dim st As Double

st = Timer

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

With Sheets("Orginal List")
.Activate
.Range("A1:HQ1858").Replace what:=Chr(10), replacement:="",
lookat:=xlPart
.Range("A1:HQ1858").Select
With Selection
.WrapText = False
.MergeCells = False
End With

varCheck = .Range("A1:A1858")

For i = 1 To UBound(varCheck)
Tmp = varCheck(i, 1)
c = Evaluate("=ADDRESS(MIN(IF($C$1:$HQ$950=" & Tmp _
& ",ROW($1:$950))),MIN(IF($C$1:$HQ$950=" & Tmp &
",COLUMN(C:HQ))))")
If Not IsError(c) Then
If Len(Range(c)) = 0 Then
Sheets("New List").Cells(Rows.Count, 1).End(xlUp)(2) _
.Resize(, 23).Value = Range(c).Offset(, 1).Resize(,
23).Value
Else
Sheets("New List").Cells(Rows.Count, 1).End(xlUp)(2) _
.Resize(, 12).Value = Range(c).Resize(, 12).Value
End If
.Range(c).Cut .Range(c).Offset(1, -1)
End If
Next
End With
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
MsgBox Format(Timer - st, "0.000")
End Sub


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

Wow, thanks Claus.

I ran Sub ReDoData() and it moved the index numbers to left of the serial numbers, but did not transfer to New List sheet. (Timer did not work, as I saw no message box)

Ran the Sub ReDoData2() and it worked fine, as near as I can tell. Data looks fine on New List sheet, but did not return 1858 entries. I suspect this is due to "errors" on the Orginal List sheet data field. I found some duplicate index numbers within the field, so that looks like a "user must fix" problem. And I would guess there are some index numbers in column A that do not exist in the field. Timer did not work on this code either, as I saw no message box here also. A time is not necessary, we know it has a lot of work to do and will take a few minutes.)

Appreciate the code, it does sorta tames down a really wildly laid out worksheet.

Howard

Just curious why you presume user has automatic Calculation...

Dim lCalcMode&

With Application
lCalcMode = .Calculation: .Calculation = xlCalculationManual
'...
End With

'...code

With Application
.Calculation = lCalcMode
'...
End With

...when it's easy to preserve/restore user setting!

Another issue is when more than one procedure is coded to toggle common
settings. I use a central handler routine that ensures only one process
has control...


'--------------------------------------------------------------------------------------
' **Note: EnableFastCode requires the following declarations be in a
standard module.
'--------------------------------------------------------------------------------------
'Type udtAppModes
' 'Default types
' Events As Boolean: CalcMode As XlCalculation: Display As Boolean:
CallerID As String
' 'Project-specific types
'End Type
'Public AppMode As udtAppModes
'--------------------------------------------------------------------------------------
Sub EnableFastCode(Caller$, Optional SetFast As Boolean = True)
' **Note: Requires 'Type udtAppModes' and 'Public AppMode As
udtAppModes' declarations

'The following will make sure only the Caller has control,
'and allows any Caller to take control when not in use.
If AppMode.CallerID < Caller Then _
If AppMode.CallerID < "" Then Exit Sub

With Application
If SetFast Then
AppMode.Display = .ScreenUpdating: .ScreenUpdating = False
AppMode.CalcMode = .Calculation: .Calculation =
xlCalculationManual
AppMode.Events = .EnableEvents: .EnableEvents = False
AppMode.CallerID = Caller
Else
.ScreenUpdating = AppMode.Display
.Calculation = AppMode.CalcMode
.EnableEvents = AppMode.Events
AppMode.CallerID = ""
End If
End With
End Sub

...where Caller is defined in the process controlling these settings
like so...

Sub MyAction()
Const sSource$ = "MyAction"

EnableFastCode sSource
'...code

EnableFastCode sSource, False
End Sub

...so if the above routine calls other procedures that also toggle these
settings, they can't interfere with the original caller's control. The
other procedures may be used independantly and so may need to toggle
settings if not already 'in play' by some other proc.!

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

Hi Howard,

Am Mon, 30 Mar 2015 16:07:32 -0700 (PDT) schrieb L. Howard:

I ran Sub ReDoData() and it moved the index numbers to left of the serial numbers, but did not transfer to New List sheet. (Timer did not work, as I saw no message box)

on my machine ReDoData is faster than ReDoData2 and it works absolutely
correct. All matches will be written to New List.


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

On Monday, March 30, 2015 at 10:43:55 PM UTC-7, Claus Busch wrote:
Hi Howard,

Am Mon, 30 Mar 2015 16:07:32 -0700 (PDT) schrieb L. Howard:

I ran Sub ReDoData() and it moved the index numbers to left of the serial numbers, but did not transfer to New List sheet. (Timer did not work, as I saw no message box)

on my machine ReDoData is faster than ReDoData2 and it works absolutely
correct. All matches will be written to New List.


Regards
Claus B.
--

I was sure it was good code, not sure why it does not play nice with me.

I will try some more to see if I can make it work on my end.

Thanks, Howard

Hi Claus,

Would you mind taking a look at this workbook.

https://www.dropbox.com/s/3qdiiqqwip...%201.xlsm?dl=0

The ReDoData (slightly renamed in the workbook) Almost works, but is not making a full and clean transfer to New list sheet.

I did get the msgbox time notification in this new workbook.

Howard

Hi Howard,

Am Tue, 31 Mar 2015 05:15:51 -0700 (PDT) schrieb L. Howard:

https://www.dropbox.com/s/3qdiiqqwip...%201.xlsm?dl=0

now that I saw your workbook I could check the data. The values in
column A are unique and so are the found cell addresses in XFD.
I revised the code because you don't need varTmp and the Dictionary.
So I checked carefully I could not find out why 3 values are missing.
You have 1857 items in column A and also 1857 addresses but in New List
there are only 1854 rows filled.
Have a look:
https://onedrive.live.com/?cid=9378A...121822A3%21326
for your workbook.


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

On Tuesday, March 31, 2015 at 7:02:40 AM UTC-7, Claus Busch wrote:
Hi Howard,

Am Tue, 31 Mar 2015 05:15:51 -0700 (PDT) schrieb L. Howard:

https://www.dropbox.com/s/3qdiiqqwip...%201.xlsm?dl=0

now that I saw your workbook I could check the data. The values in
column A are unique and so are the found cell addresses in XFD.
I revised the code because you don't need varTmp and the Dictionary.
So I checked carefully I could not find out why 3 values are missing.
You have 1857 items in column A and also 1857 addresses but in New List
there are only 1854 rows filled.
Have a look:
https://onedrive.live.com/?cid=9378A...121822A3%21326
for your workbook.


Regards
Claus B.

Hi Claus,

When I run the code the list on New List sheet is only the index numbers without the serial numbers to the left.

Should be:

1-1-1-2 x x x x x x x x x x x x x x x x x x x x x x

for each index number.

I get column A with the index numbers but no serial numbers in columns B to column W.

Column L has a smattering of index numbers.

Are you getting all the serial numbers when you run it?

Howard

Hi Howard,

Am Tue, 31 Mar 2015 10:36:47 -0700 (PDT) schrieb L. Howard:

When I run the code the list on New List sheet is only the index numbers without the serial numbers to the left.

what exactly do you want to get into New List? You said the match cell
resize(,12). But most of the match cells are in empty rows. Therefore
there are no other values.
Please explain a little further.


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

Hi again,

Am Tue, 31 Mar 2015 19:44:46 +0200 schrieb Claus Busch:

what exactly do you want to get into New List? You said the match cell
resize(,12). But most of the match cells are in empty rows. Therefore
there are no other values.

or should I move the match cells before copy the range?
But if I unmerge the cells most of the match cells are in column C and
when I move they are in column B.


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

On Tuesday, March 31, 2015 at 10:54:17 AM UTC-7, Claus Busch wrote:
Hi again,

Am Tue, 31 Mar 2015 19:44:46 +0200 schrieb Claus Busch:

what exactly do you want to get into New List? You said the match cell
resize(,12). But most of the match cells are in empty rows. Therefore
there are no other values.

or should I move the match cells before copy the range?
But if I unmerge the cells most of the match cells are in column C and
when I move they are in column B.


Regards
Claus B.

Hi Claus,

Seems I have not explained well enough.

Here is what New List should look like. (No code, just an example)

https://www.dropbox.com/s/nu913gbpyv...mple.xlsx?dl=0

Keeping the sequence of the index numbers in column A in order would be a plus, but a sorting method could probably be worked out to do that on the New List sheet.

Sorry for not making it clearer.

Howard

Hi Howard,

Am Tue, 31 Mar 2015 12:01:06 -0700 (PDT) schrieb L. Howard:

Here is what New List should look like. (No code, just an example)

that is much easier than before.
Please look again in OneDrive for your Workbook.


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

On Tuesday, March 31, 2015 at 12:17:13 PM UTC-7, Claus Busch wrote:
Hi Howard,

Am Tue, 31 Mar 2015 12:01:06 -0700 (PDT) schrieb L. Howard:

Here is what New List should look like. (No code, just an example)

that is much easier than before.
Please look again in OneDrive for your Workbook.


Regards
Claus B.

Hi Claus,

That is looking good, but I find it has some trouble dealing with the index numbers that have the serial numbers in two rows.

I devised a much shorter version of data and adjusted the code to fit it. Easier and quicker to run and view results. Same data just much less of it.

Run the code on Orginal List sheet, then go to New List sheet and look at column M and down. Column M is 12 columns from B where the serial numbers start. The serial numbers on Orginal List are one row of 22 or two rows of 11.

I sense what is happening, I think, but don't know how to explain it or fix it.

https://www.dropbox.com/s/ecqtrep6ax...sion.xlsm?dl=0

Howard

Hi Howard,

Am Tue, 31 Mar 2015 16:47:11 -0700 (PDT) schrieb L. Howard:

Run the code on Orginal List sheet, then go to New List sheet and look at column M and down. Column M is 12 columns from B where the serial numbers start. The serial numbers on Orginal List are one row of 22 or two rows of 11.

I hope I got it.
Please look he
https://onedrive.live.com/?cid=9378A...121822A3%21326
for "BlueGrass_New"


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

I hope I got it.
Please look he
https://onedrive.live.com/?cid=9378A...121822A3%21326
for "BlueGrass_New"


Regards
Claus B.
--

It seems to miss the second row of 11 serial numbers for the indexes that are on two rows.

If we look at index 1-1-1-5, which is a double row example:

On Orginal List sheet it is this:

1-1-1-5 14AP606022078875 14AP606022078708 14AP606022076159 14AP606022079004 14AP606022078133 14AP606022079169 14AP606022079172 14AP606022079173 14AP606022079496 14AP606022079216 14AP606022079126

14AP606022078707 14AP606022077563 14AP606022077006 14AP606022079052 14AP606022079024 14AP606022079170 14AP606022079296 14AP606022079295 14AP606022079497 14AP606022079516 14AP606022079221

On the New List sheet it is this:

1-1-1-5 14AP606022078875 14AP606022078708 14AP606022076159 14AP606022079004 14AP606022078133 14AP606022079169 14AP606022079172 14AP606022079173 14AP606022079496 14AP606022079216 14AP606022079126

Followed by blank cells where the second 11 serial numbers should be.

(Not sure how the word wrap will present this, but hopefully its understandable)

Howard

Hi Howard,

Am Wed, 1 Apr 2015 03:36:33 -0700 (PDT) schrieb L. Howard:

It seems to miss the second row of 11 serial numbers for the indexes that are on two rows.

please have another look for BlueGrass_New


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

Hi Howard,

Am Wed, 1 Apr 2015 03:36:33 -0700 (PDT) schrieb L. Howard:

It seems to miss the second row of 11 serial numbers for the indexes that are on two rows.

I downloaded your version1 again and I looked in which columns the
indexes are. Then I put these columns in a range and made a version with
find.
Now that the range to look in is not the whole table the macro is faster
than the macro with the formulas.
Have a look in OneDrive for "BlueGrass Version2"


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

I downloaded your version1 again and I looked in which columns the
indexes are. Then I put these columns in a range and made a version with
find.
Now that the range to look in is not the whole table the macro is faster
than the macro with the formulas.
Have a look in OneDrive for "BlueGrass Version2"


Regards
Claus B.

Yes, that looks very good to me.

The goal was to take the difficult to read info on one sheet and compile it to a single easy to read and reference list on another sheet.

This code sure seems to do exactly that for me.

To be clear, if the code was to be run on another sheet with a different "map" of the solar panels, I would need to adjust the column ranges to match where the "two row" blocks occur. Correct?

Thanks Claus.

Howard

Hi Howard,

Am Wed, 1 Apr 2015 10:04:31 -0700 (PDT) schrieb L. Howard:

To be clear, if the code was to be run on another sheet with a different "map" of the solar panels, I would need to adjust the column ranges to match where the "two row" blocks occur. Correct?

in another map you have to look for the merged cells and in which
columns these are to create the range to search the items.


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

Hi again,

Am Wed, 1 Apr 2015 19:14:23 +0200 schrieb Claus Busch:

in another map you have to look for the merged cells and in which
columns these are to create the range to search the items.

I am looking for a way to find the columns with code. But then the
macros runs longer as in a hardcoded range.


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

Hi Howard,

Am Wed, 1 Apr 2015 10:04:31 -0700 (PDT) schrieb L. Howard:

To be clear, if the code was to be run on another sheet with a different "map" of the solar panels, I would need to adjust the column ranges to match where the "two row" blocks occur. Correct?

try the following code. It looks for the merged cells and the columns
and you have not to hardcode the range:

Sub ReDoData()
Dim varCheck As Variant, varTmp As Variant, varCol As Variant
Dim varAdd() As Variant
Dim myDic As Object
Dim i As Long, n As Long, m As Long
Dim rngBig As Range, c As Range, myRng As Range, rngC As Range
Dim st As Double

st = Timer

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

With Sheets("Orginal List")
.Activate
For Each rngC In .Range("C6:HQ950")
If rngC.MergeCells Then
ReDim Preserve varAdd(n)
varTmp = Split(rngC.MergeArea.Cells(1, 1).Address(1, 0),
"$")
varAdd(n) = varTmp(0)
n = n + 1
End If
Next
Set myDic = CreateObject("Scripting.Dictionary")
For n = 0 To UBound(varAdd)
myDic(varAdd(n)) = varAdd(n)
Next
varCol = myDic.items

For n = 0 To UBound(varCol)
If rngBig Is Nothing Then
Set rngBig = Columns(varCol(n))
Else
Set rngBig = Application.Union(rngBig, Columns(varCol(n)))
End If
Next


.Range("A1:HQ1858").Replace what:=Chr(10), replacement:="",
lookat:=xlPart
.Range("A1:HQ1858").Select
With Selection
.WrapText = False
.MergeCells = False
End With
Application.Goto .Range("A1")

varCheck = .Range("A1:A1858")

For i = 1 To UBound(varCheck)
Set c = rngBig.Find(varCheck(i, 1), LookIn:=xlValues,
lookat:=xlWhole)
If Not c Is Nothing Then
m = m + 1
c.Cut c.Offset(1, -1)
If Len(c.Offset(, 12)) 0 Then
Sheets("New List").Range("A" & m).Resize(, 23).Value _
= c.Resize(, 23).Value
Else
Sheets("New List").Range("A" & m).Resize(, 12).Value _
= c.Resize(, 12).Value
m = m + 1
Sheets("New List").Range("B" & m).Resize(, 11).Value _
= c.Offset(1, 1).Resize(, 11).Value
End If
End If
Next
End With
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

MsgBox Format(Timer - st, "0.000")
End Sub


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

On Wednesday, April 1, 2015 at 10:42:06 AM UTC-7, Claus Busch wrote:
Hi Howard,

Am Wed, 1 Apr 2015 10:04:31 -0700 (PDT) schrieb L. Howard:

To be clear, if the code was to be run on another sheet with a different "map" of the solar panels, I would need to adjust the column ranges to match where the "two row" blocks occur. Correct?

try the following code. It looks for the merged cells and the columns
and you have not to hardcode the range:


Hi Claus,

That is the just great. I don't know what could be better than this.

Thanks for all your effort.

Howard

Hi Claus,

Would you mind taking a look at this workbook.

https://www.dropbox.com/s/3qdiiqqwip...%201.xlsm?dl=0

The ReDoData (slightly renamed in the workbook) Almost works, but is
not making a full and clean transfer to New list sheet.

I did get the msgbox time notification in this new workbook.

Howard

I have to ask...

How did this data get into the worksheet in this layout state in the
1st place?

...reason being this is definitely not how we log solar panel serials on
our installations/farms!

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

On Wednesday, April 1, 2015 at 12:33:16 PM UTC-7, GS wrote:
Hi Claus,

Would you mind taking a look at this workbook.

https://www.dropbox.com/s/3qdiiqqwip...%201.xlsm?dl=0

The ReDoData (slightly renamed in the workbook) Almost works, but is
not making a full and clean transfer to New list sheet.

I did get the msgbox time notification in this new workbook.

Howard

I have to ask...

How did this data get into the worksheet in this layout state in the
1st place?

..reason being this is definitely not how we log solar panel serials on
our installations/farms!

--
Garry


Hi Gary,

From the OP in his brief explanation of what he is wanting to do.


So my aim is with a macro is to produce what the next sheet looks like "PAC Sheet". A way to unmerge all the "Combiner Boxes", e.g. 1-1-1-1 and then copy and paste the serial numbers attached to that box, on the same row (Basically tidying the whole thing up). Also putting them in order, (1-1-1-1, 1-1-1-2 all the way to 4-14-5-7, in this example) I've done this one manually and i'm sure you can appreciate how long that took!

The first sheet is drawn this way as they replicate exactly how the solar farm layout looks. This makes it easier the the scanners to go round and place barcodes into the sheet.<<

So, I suppose there is more than one way to farm your solar panels, except I am sure they have all to face the sun.<g

Howard

And just to add, here is my comment to OP after offering Claus' last code.


In general, I would mention that with the unusual layout of your data on Orginal List, where it mimics on the ground placement of equipment, a map of sorts, instead of typical column & rows of data, coding is a bit tougher. With that said, making adjustments are not as routine as they might be when the data generally follows Excel do's and don't's for data stuff.

I have had to rely on expert advice to do a preponderance of the code. So as this has progressed, I have become more of a messenger. I do not fully understand all the code.

Howard <<

Howard

From the OP in his brief explanation of what he is wanting to do.


So my aim is with a macro is to produce what the next sheet looks
like "PAC Sheet". A way to unmerge all the "Combiner Boxes", e.g.
1-1-1-1 and then copy and paste the serial numbers attached to that
box, on the same row (Basically tidying the whole thing up). Also
putting them in order, (1-1-1-1, 1-1-1-2 all the way to 4-14-5-7,
in this example) I've done this one manually and i'm sure you can
appreciate how long that took!

The first sheet is drawn this way as they replicate exactly how the
solar farm layout looks. This makes it easier the the scanners to go
round and place barcodes into the sheet.<<

So, I suppose there is more than one way to farm your solar panels,
except I am sure they have all to face the sun.<g

Sounds convoluted and counter productive to me! Regardless of how the
solar panels are grouped/situated, the index is the group ID. Any solar
farms I've done stuff for layout panels in an x/y grid. This means a
grouped section has an identifier that's used in the farm's 'map'.
Here\s how we do this same task...

GrpID1
panel1.1ID panel1.2ID panel1.3ID...
panel2.1ID panel2.2ID panel2.3ID...
...

GrpID2
panel1.1ID panel1.2ID panel1.3ID...
panel2.1ID panel2.2ID panel2.3ID...
...


...where the position in the group is R1C1-like numbering for however
many rows/cols a group has.

There's no reason why the original sheet can't be laid out similar to
above since barcode scanners input to the active cell. Thus, the task
you have is just doing similar as above *after the fact*! The scanner
doesn't care which cell is its target!

The farm 'map' might look something like this...

N
W E
S

============================= =============================
GrpID1 GrpID2
============================= =============================

================================================== ============
GrpID3
================================================== ============

================================================== ============
GrpID4

================================================== ============

...where these are setup like an organization chart without connectors.
This can be the entire real estate of the farm OR just an area of the a
farm containing multiple areas.

Panels normally face the sun, but we also have a turntable tracker
system that follows the sun. Our wind turbine farms also use the same
structure because, over the years, this has proven to be an efficient
and low-maintenance way to adequately document our energy units.

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

On Wednesday, April 1, 2015 at 6:07:12 PM UTC-7, GS wrote:
From the OP in his brief explanation of what he is wanting to do.


So my aim is with a macro is to produce what the next sheet looks
like "PAC Sheet". A way to unmerge all the "Combiner Boxes", e.g.
1-1-1-1 and then copy and paste the serial numbers attached to that
box, on the same row (Basically tidying the whole thing up). Also
putting them in order, (1-1-1-1, 1-1-1-2 all the way to 4-14-5-7,
in this example) I've done this one manually and i'm sure you can
appreciate how long that took!

The first sheet is drawn this way as they replicate exactly how the
solar farm layout looks. This makes it easier the the scanners to go
round and place barcodes into the sheet.<<

So, I suppose there is more than one way to farm your solar panels,
except I am sure they have all to face the sun.<g

Sounds convoluted and counter productive to me! Regardless of how the
solar panels are grouped/situated, the index is the group ID. Any solar
farms I've done stuff for layout panels in an x/y grid. This means a
grouped section has an identifier that's used in the farm's 'map'.
Here\s how we do this same task...

GrpID1
panel1.1ID panel1.2ID panel1.3ID...
panel2.1ID panel2.2ID panel2.3ID...
...

GrpID2
panel1.1ID panel1.2ID panel1.3ID...
panel2.1ID panel2.2ID panel2.3ID...
...


..where the position in the group is R1C1-like numbering for however
many rows/cols a group has.

There's no reason why the original sheet can't be laid out similar to
above since barcode scanners input to the active cell. Thus, the task
you have is just doing similar as above *after the fact*! The scanner
doesn't care which cell is its target!

The farm 'map' might look something like this...

N
W E
S

============================= =============================
GrpID1 GrpID2
============================= =============================

================================================== ============
GrpID3
================================================== ============

================================================== ============
GrpID4

================================================== ============

..where these are setup like an organization chart without connectors.
This can be the entire real estate of the farm OR just an area of the a
farm containing multiple areas.

Panels normally face the sun, but we also have a turntable tracker
system that follows the sun. Our wind turbine farms also use the same
structure because, over the years, this has proven to be an efficient
and low-maintenance way to adequately document our energy units.

--
Garry


All that make some sense to me, and I suspect the reason the OP even offered a "reason" as to why the sheet is so seemingly disarrayed is because he earlier said he is not novice to Excel, but really was a newby to VBA. Perhaps feeling like he needed to explain why the sheet looked a mess.

But to the point of the OP, it was how to deal the task of rearranging the data he has in Excel, as opposed to proper or preferred solar panel lay out and procedure.

Howard

Given the blatent evidence, I'll bite my tongue on the "..not novice to
excel..." claim!


But to the point of the OP, it was how to deal the task of
rearranging the data he has in Excel, as opposed to proper or
preferred solar panel lay out and procedure

Well, my point is that the data should be laid out for intended usage,
NOT how the panels are physically situated.

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion