Need help with a difficult macro - don't really know how to describe it for a title

[DJKemp20]

Hi guys,

So I'm completely new to VBA and Python. I work in a Physical Chemistry lab that involves me processing a large amount of data and there's a particularly tedious task which I am struggling to get automated.

I've attached an image of an excel spreadsheet as an example below for what I need to do get done with an explanation below:






Using the above images as an example and starting at cell C1:

1. The value in C1 is 1194.5. What I need to do is to move the white part of the column i.e C4 and everything below so that the top cell (C4) is in line with a cell in the B column which has the same value or +/- 0.1 of C1. So C1 is 1194.5 and B6 is 1194.6 (which is 1194.6 - 0.1) so C4 would need to be in line with B6 and C5 would be in line with B7, C6 with B8 etc

2. Next would be D4 which is 1194.7. The data from D4 and below will need to be moved so that D4 is in the same row as B6 ( i.e 1194.6 +0.1)

3. Next would be E1 which is 1194.9. The data from D4 and below will need to be moved so that D4 is in the same column as 1194.9 (D7) etc etc....


As you may understand, this is very tedious and recording a simple macro does not work as sometimes the columns need to be moved by different amounts.
Is this a trivial macro to write?

Thanks very much for your time and any help is much appreciated with this.

David

 

[MARK858]

Please ignore as I think it is more complicated than what I posted.

 

[Beyond_avarice]

It seems like you want the column headers to land with in .1 of what is listed in the Rows(Column "B").

Column "G" shows header of 1195.3 and you have the data moved down to Row Label 1195.2. Why this row and not 1195.4?

What is to happen to Headers like in Columns "J" and "K"? Or if the headers are not within .1 of any of your Row labels?

 

[DJKemp20]

It seems like you want the column headers to land with in .1 of what is listed in the Rows(Column "B").

Column "G" shows header of 1195.3 and you have the data moved down to Row Label 1195.2. Why this row and not 1195.4?

What is to happen to Headers like in Columns "J" and "K"? Or if the headers are not within .1 of any of your Row labels?

Hi, thanks for the reply.

That's correct, yes.
With regards to, for example, Column G being within 0.1 of 1195.2 and 1195.4, it doesn't matter which row each column of data is matched with, so long as it's within 0.1. I have tended to move the columns manually to match the higher value (1195.4) but the difference it actually makes to the figure that I plot from the data is negligible, so either is fine.

I seem to have missed out the data from column J and K in the second figure for some reason but the data from columns J and K should be processed the same way as the others I have shown across the two figures. The way the data works, however, is that every single column of data will have a corresponding row where the column header will match or be within 0.1. There won't be any cases where it doesn't match.
Hope that is more helpful,

Thanks for your help.

 

[MARK858]

A bit ugly but try the code below.

Very lightly tested as you pasted an image that we can't copy the data from and I wasn't willing to retype all your data.
To post screenshots we can copy from either see the links in my signature block below or see the thread in the link here

Sub xxxx()
    Dim i As Long, myCell As Range
    Application.ScreenUpdating = False

    For i = 3 To Cells(1, Columns.Count).End(xlToLeft).Column

        For Each myCell In Range("B4:B" & Range("B" & Rows.Count).End(xlUp).Row)
            If myCell.Value <= Cells(1, i).Value + 0.1 And myCell.Value >= Cells(1, i).Value - 0.1 Then
                Cells(4, i).Resize(myCell.Row - 4).Insert Shift:=xlDown
                GoTo mystart
            End If
        Next
mystart:
    Next
    Application.ScreenUpdating = True
End Sub

 

[DJKemp20]

A bit ugly but try the code below.

Very lightly tested as you pasted an image that we can't copy the data from and I wasn't willing to retype all your data.
To post screenshots we can copy from either see the links in my signature block below or see the thread in the link here

Sub xxxx()
    Dim i As Long, myCell As Range
    Application.ScreenUpdating = False

    For i = 3 To Cells(1, Columns.Count).End(xlToLeft).Column

        For Each myCell In Range("B4:B" & Range("B" & Rows.Count).End(xlUp).Row)
            If myCell.Value <= Cells(1, i).Value + 0.1 And myCell.Value >= Cells(1, i).Value - 0.1 Then
                Cells(4, i).Resize(myCell.Row - 4).Insert Shift:=xlDown
                GoTo mystart
            End If
        Next
mystart:
    Next
    Application.ScreenUpdating = True
End Sub

A bit ugly but try the code below.

Very lightly tested as you pasted an image that we can't copy the data from and I wasn't willing to retype all your data.
To post screenshots we can copy from either see the links in my signature block below or see the thread in the link here

Sub xxxx()
    Dim i As Long, myCell As Range
    Application.ScreenUpdating = False

    For i = 3 To Cells(1, Columns.Count).End(xlToLeft).Column

        For Each myCell In Range("B4:B" & Range("B" & Rows.Count).End(xlUp).Row)
            If myCell.Value <= Cells(1, i).Value + 0.1 And myCell.Value >= Cells(1, i).Value - 0.1 Then
                Cells(4, i).Resize(myCell.Row - 4).Insert Shift:=xlDown
                GoTo mystart
            End If
        Next
mystart:
    Next
    Application.ScreenUpdating = True
End Sub

Hi, I did try it out on a set of data and it crashed. I've uploaded a set of data in the way you mentioned above, so maybe that'll be more useful. It's a different set of data than the original set but the code needs to work on any set of data.
I've uploaded an image of what came out in the debugger.

Thanks again

[/URL][/IMG]

Book1
	A	B	C	D	E	F	G	H	I	J	K
1			1196.1	1196.3	1196.5	1196.7	1196.9	1197.1	1197.3	1197.5	1197.7
2			37905.47	37905.67	37905.87	37906.07	37906.26	37906.46	37906.66	37906.86	37907.06
3			1045.171	1045.369	1045.568	1045.766	1045.964	1046.163	1046.361	1046.56	1046.758
4	36661.62	1196.1	20541.3	7981.3	23559.9	21712.7	16702.7	17972.7	6504.1	11000.9	13377.0
5	36661.32	1196.4	20516.6	7580.9	23513.7	20868.0	16848.0	17286.6	7348.0	10646.1	13706.6
6	36661.03	1196.7	20474.1	7712.7	22837.0	20377.0	17372.7	17869.9	8547.0	10315.1	14088.4
7	36660.74	1197.0	21570.7	7619.3	23205.0	20852.1	18705.0	18516.4	11229.3	8956.0	14245.0
8	36660.44	1197.3	20516.6	7580.9	23513.7	20868.0	16848.0	17286.6	7348.0	10646.1	13706.6
9	36660.15	1197.5	20474.1	7712.7	22837.0	20377.0	17372.7	17869.9	8547.0	10315.1	14088.4
10	36659.86	1197.8	21570.7	7619.3	23205.0	20852.1	18705.0	18516.4	11229.3	8956.0	14245.0
Sheet1

Cell Formulas
Range	Formula
C1	=Signal!C1
C2	=Signal!C2
C3	=Signal!C3
C4	=AVERAGE(Min!D3:D9)
C5	=AVERAGE(Min!D4:D10)
C6	=AVERAGE(Min!D5:D11)
C7	=AVERAGE(Min!D6:D12)
C8	=AVERAGE(Min!D4:D10)
C9	=AVERAGE(Min!D5:D11)
C10	=AVERAGE(Min!D6:D12)
D1	=Signal!D1
D2	=Signal!D2
D3	=Signal!D3
D4	=AVERAGE(Min!E3:E9)
D5	=AVERAGE(Min!E4:E10)
D6	=AVERAGE(Min!E5:E11)
D7	=AVERAGE(Min!E6:E12)
D8	=AVERAGE(Min!E4:E10)
D9	=AVERAGE(Min!E5:E11)
D10	=AVERAGE(Min!E6:E12)
E1	=Signal!E1
E2	=Signal!E2
E3	=Signal!E3
E4	=AVERAGE(Min!F3:F9)
E5	=AVERAGE(Min!F4:F10)
E6	=AVERAGE(Min!F5:F11)
E7	=AVERAGE(Min!F6:F12)
E8	=AVERAGE(Min!F4:F10)
E9	=AVERAGE(Min!F5:F11)
E10	=AVERAGE(Min!F6:F12)
F1	=Signal!F1
F2	=Signal!F2
F3	=Signal!F3
F4	=AVERAGE(Min!G3:G9)
F5	=AVERAGE(Min!G4:G10)
F6	=AVERAGE(Min!G5:G11)
F7	=AVERAGE(Min!G6:G12)
F8	=AVERAGE(Min!G4:G10)
F9	=AVERAGE(Min!G5:G11)
F10	=AVERAGE(Min!G6:G12)
G1	=Signal!G1
G2	=Signal!G2
G3	=Signal!G3
G4	=AVERAGE(Min!H3:H9)
G5	=AVERAGE(Min!H4:H10)
G6	=AVERAGE(Min!H5:H11)
G7	=AVERAGE(Min!H6:H12)
G8	=AVERAGE(Min!H4:H10)
G9	=AVERAGE(Min!H5:H11)
G10	=AVERAGE(Min!H6:H12)
H1	=Signal!H1
H2	=Signal!H2
H3	=Signal!H3
H4	=AVERAGE(Min!I3:I9)
H5	=AVERAGE(Min!I4:I10)
H6	=AVERAGE(Min!I5:I11)
H7	=AVERAGE(Min!I6:I12)
H8	=AVERAGE(Min!I4:I10)
H9	=AVERAGE(Min!I5:I11)
H10	=AVERAGE(Min!I6:I12)
I1	=Signal!I1
I2	=Signal!I2
I3	=Signal!I3
I4	=AVERAGE(Min!J3:J9)
I5	=AVERAGE(Min!J4:J10)
I6	=AVERAGE(Min!J5:J11)
I7	=AVERAGE(Min!J6:J12)
I8	=AVERAGE(Min!J4:J10)
I9	=AVERAGE(Min!J5:J11)
I10	=AVERAGE(Min!J6:J12)
J1	=Signal!J1
J2	=Signal!J2
J3	=Signal!J3
J4	=AVERAGE(Min!K3:K9)
J5	=AVERAGE(Min!K4:K10)
J6	=AVERAGE(Min!K5:K11)
J7	=AVERAGE(Min!K6:K12)
J8	=AVERAGE(Min!K4:K10)
J9	=AVERAGE(Min!K5:K11)
J10	=AVERAGE(Min!K6:K12)
K1	=Signal!K1
K2	=Signal!K2
K3	=Signal!K3
K4	=AVERAGE(Min!L3:L9)
K5	=AVERAGE(Min!L4:L10)
K6	=AVERAGE(Min!L5:L11)
K7	=AVERAGE(Min!L6:L12)
K8	=AVERAGE(Min!L4:L10)
K9	=AVERAGE(Min!L5:L11)
K10	=AVERAGE(Min!L6:L12)
A4	=Signal!A4
A5	=Signal!A5
A6	=Signal!A6
A7	=Signal!A7
A8	=Signal!A8
A9	=Signal!A9
A10	=Signal!A10
B4	=Signal!B4
B5	=Signal!B5
B6	=Signal!B6
B7	=Signal!B7
B8	=Signal!B8
B9	=Signal!B9
B10	=Signal!B10

 

[MARK858]

Try the code below...

Sub xxxx2()
    Dim i As Long, myCell As Range
    Application.ScreenUpdating = False

    For i = 3 To Cells(1, Columns.Count).End(xlToLeft).Column

        For Each myCell In Range("B4:B" & Range("B" & Rows.Count).End(xlUp).Row)
        
            If myCell.Value <= Round(Cells(1, i).Value + 0.1, 1) And myCell.Value >= Round(Cells(1, i).Value - 0.1, 1) Then
                If myCell.Row > 4 Then Cells(4, i).Resize(myCell.Row - 4).Insert Shift:=xlDown
                GoTo mystart
            End If

        Next
mystart:
    Next
    Application.ScreenUpdating = True
End Sub

 

[DJKemp20]

Try the code below...

Sub xxxx2()
    Dim i As Long, myCell As Range
    Application.ScreenUpdating = False

    For i = 3 To Cells(1, Columns.Count).End(xlToLeft).Column

        For Each myCell In Range("B4:B" & Range("B" & Rows.Count).End(xlUp).Row)
        
            If myCell.Value <= Round(Cells(1, i).Value + 0.1, 1) And myCell.Value >= Round(Cells(1, i).Value - 0.1, 1) Then
                If myCell.Row > 4 Then Cells(4, i).Resize(myCell.Row - 4).Insert Shift:=xlDown
                GoTo mystart
            End If

        Next
mystart:
    Next
    Application.ScreenUpdating = True
End Sub

Aha! That's perfect. Thank you so much for your help, that'll make my life a lot easier!