VBA/excel 2003 question with complexty

[Ria]

Hi VBA experts:

I am using excel 2003 and got into bit complex situation and was trying to solve it into pieces but could not complete the picture. Web help is not a single solution then I stopped and here I am. Here are requirements:
Either use Excel or VBA
1. in column N, look for first set/block/range of values e.g. N119:N123
2. find minimum value from range N119:N123
3. minimum value from above point 2, match with range D119:D123 and get row number
4. concatenate column "A" with row number from point 3 and get date from column A
5. find next range/set/block of values in column n and repeat above process
6. repeat above process until end of data in column N
7. Dates from point 4, put in column O any where without leaving blanks
NOTE: ranges/block/set of values in column N, are dynamic and may vary and location could also change
Excel file has too much data, will not upload but will try to give enough data to solve the problem.

Any help and consideration is highly appreciated.

Thanks,

Ria

 

[Marc L]

Hi !

Seems not very difficult but to well understand your need,
join a workbook with an exact source worksheet
and a desired result worksheet … Or just put in source worksheet
desired result in red for example …
​

 

[Ria]

Hi !

Seems not very difficult but to well understand your need,
join a workbook with an exact source worksheet
and a desired result worksheet … Or just put in source worksheet
desired result in red for example …
​

Thanks Marc for reply.

In attached file, I highlighted columns O:S yellow. I produced results manually for each range in column N. And column Q 117:Q124 is my need/output.

I want it in VBA but can not make logic how and how to loop through many times in same column for different ranges.

Please let me know if any question or clarification.

I like quotation end of your message (Never argue with an idiot, he'll bring you down to his level - then beat you with experience).

Regards

Ria

 

[Ria]

Hi !

Seems not very difficult but to well understand your need,
join a workbook with an exact source worksheet
and a desired result worksheet … Or just put in source worksheet
desired result in red for example …
​

Hi Marc:
Using VBA, with following code, I was able to process first range

(N119:N123) in column N. However, I am unable to process remaining ranges

in column N (e.g.N195:N197, N270:N279, N399:N407, N447:N455 AND

N526:N526). It needs loop to search find next ranges after empty cells

and find empty cells after non-empty cells. Please help me if you can.

Code is in attached file Module 5, last sub.

Thanks,

Ria

 

[Marc L]

As your aim seems dates without blank, just a sign is placed near
the smallest value of each area range and final output starts in Q2 :​

Sub Demo()
    Dim Rg As Range
    Application.ScreenUpdating = False

    With Sheet2
        .Columns("O:Q").Clear
        .[S2].Formula = "=ISNUMBER(N2)"
        .Cells(1).CurrentRegion.AdvancedFilter xlFilterInPlace, .[S1:S2]

        With .[_FilterDatabase].Columns(14)
            If .SpecialCells(xlCellTypeVisible).Count > 1 Then
              .Rows(1).Hidden = True

                For Each Rg In .SpecialCells(xlCellTypeVisible).Areas
                    Rg(Application.Match(Application.Min(Rg), Rg, 0)).Offset(, 1).Value = "¤"
                Next
            Else
                .ShowAllData
            End If
        End With

        If .FilterMode Then
          .[S2].Formula = "=O2=""¤"""
          .Cells(1).CurrentRegion.AdvancedFilter xlFilterInPlace, .[S1:S2]
          .[_FilterDatabase].Columns(1).Copy .Cells(17)
          .ShowAllData
          .Activate:      ActiveWindow.ScrollRow = 1
        End If

        .[S2].Clear
    End With
End Sub

Do you like it ? So thanks to click on bottom right Like !
​

 

[Ria]

As your aim seems dates without blank, just a sign is placed near
the smallest value of each area range and final output starts in Q2 :​

Sub Demo()
    Dim Rg As Range
    Application.ScreenUpdating = False

    With Sheet2
        .Columns("O:Q").Clear
        .[S2].Formula = "=ISNUMBER(N2)"
        .Cells(1).CurrentRegion.AdvancedFilter xlFilterInPlace, .[S1:S2]

        With .[_FilterDatabase].Columns(14)
            If .SpecialCells(xlCellTypeVisible).Count > 1 Then
              .Rows(1).Hidden = True

                For Each Rg In .SpecialCells(xlCellTypeVisible).Areas
                    Rg(Application.Match(Application.Min(Rg), Rg, 0)).Offset(, 1).Value = "¤"
                Next
            Else
                .ShowAllData
            End If
        End With

        If .FilterMode Then
          .[S2].Formula = "=O2=""¤"""
          .Cells(1).CurrentRegion.AdvancedFilter xlFilterInPlace, .[S1:S2]
          .[_FilterDatabase].Columns(1).Copy .Cells(17)
          .ShowAllData
          .Activate:      ActiveWindow.ScrollRow = 1
        End If

        .[S2].Clear
    End With
End Sub

Do you like it ? So thanks to click on bottom right Like !
​

Marc, thanks a lot. It does exactly what I need. You saved my few nights sleep.

One more question beside this one. Do you know a way or code for:
I have line chart with few series. I want to click on chart line/series. With mouse click, it should read x, y coordinates of that point and put it in cells to use elsewhere. I do not want to redraw charts cause it is lots of work. If any code can handle it would be great.

Anyway big thanks.

Ria

 

[Marc L]

Sorry but I'm very not a chart specialist !

Better is to open a new thread for this new subject with a workbook joined
with charts and all the stuff to well understand your need …
​

 

[Ria]

Sorry but I'm very not a chart specialist !

Better is to open a new thread for this new subject with a workbook joined
with charts and all the stuff to well understand your need …
​

Thanks Marc, will do it.

 

[Ria]

As your aim seems dates without blank, just a sign is placed near
the smallest value of each area range and final output starts in Q2 :​

Sub Demo()
    Dim Rg As Range
    Application.ScreenUpdating = False

    With Sheet2
        .Columns("O:Q").Clear
        .[S2].Formula = "=ISNUMBER(N2)"
        .Cells(1).CurrentRegion.AdvancedFilter xlFilterInPlace, .[S1:S2]

        With .[_FilterDatabase].Columns(14)
            If .SpecialCells(xlCellTypeVisible).Count > 1 Then
              .Rows(1).Hidden = True

                For Each Rg In .SpecialCells(xlCellTypeVisible).Areas
                    Rg(Application.Match(Application.Min(Rg), Rg, 0)).Offset(, 1).Value = "¤"
                Next
            Else
                .ShowAllData
            End If
        End With

        If .FilterMode Then
          .[S2].Formula = "=O2=""¤"""
          .Cells(1).CurrentRegion.AdvancedFilter xlFilterInPlace, .[S1:S2]
          .[_FilterDatabase].Columns(1).Copy .Cells(17)
          .ShowAllData
          .Activate:      ActiveWindow.ScrollRow = 1
        End If

        .[S2].Clear
    End With
End Sub

Do you like it ? So thanks to click on bottom right Like !
​

Hi Marc:
Sorry to bother you again, if I use this code in any other sheet in same workbook or in different workbook, then what I need to change in code.
xl file I sent you, was created for you after deleting lots of data/charts/columns (because original one has lots of sheets, charts and data. it was not possible to upload full file).
Now I am trying to embed your code in my original xl file but can not make it working. e.g. in my original file columns has been replaced with BN, BS etc. (as N, S etc. in test file). Beside columns number/name reference, is there anything hidden I am missing (e.g. Columns(14), Cells(17)). Please clarify if you get time, no rush.
I may be naïve to tailor this code.
Big thanks,
Ria

 

[Marc L]

Best is to always join a real worksheet design …

With Sheet2 : this is the worksheet codename, could be replaced by
worksheet name like With Worksheets("FLD") …

Columns(14) is column "N" and Cells(17) is cell "Q1" …

Beware of cell in formula like N2 & O2 and
the criteria cells of advanced filter "S1:S2" …
​

 

[Ria]

Best is to always join a real worksheet design …

With Sheet2 : this is the worksheet codename, could be replaced by
worksheet name like With Worksheets("FLD") …

Columns(14) is column "N" and Cells(17) is cell "Q1" …

Beware of cell in formula like N2 & O2 and
the criteria cells of advanced filter "S1:S2" …
​

Thanks.
Not quite sure 1 & -13 in line below, assuming -13 is column A, 1 is ?
When I run code, get error on line below:
Runtme error 438
Object does not support this property or method @ line .ShowAllData
Any thoughts?
.Offset(, 1).Value = .Offset(, -13).Value
End With
Next
Else
.ShowAllData

 

[Marc L]

Column "N" is #14 : so - 13 = column #1 so yes it's column "A" …
And #14 + 1 = 15 so it's column "O" …

But these lines are not used anymore in my last code in post #5 !
​

 

[Ria]

Column "N" is #14 : so - 13 = column #1 so yes it's column "A" …
And #14 + 1 = 15 so it's column "O" …

But these lines are not used anymore in my last code in post #5 !
​

I am sorry Marc. After making appropriate reference changes, still getting error:
Runtme error 438
Object does not support this property or method @ line .ShowAllData
Only change has been made is added B with all cell references previously used (e.g. was col: N, now is BN. Here changed references:

Sub Demo()
    Dim Rg As Range
    Application.ScreenUpdating = False
   
    With Worksheets("FLD")
    'With Sheet2
        .Columns("BO:BQ").Clear
        .[BS2].Formula = "=ISNUMBER(BN2)"
        .Cells(1).CurrentRegion.AdvancedFilter xlFilterInPlace, .[BS1:BS2]

        With .[_FilterDatabase].Columns("BN")
            If .SpecialCells(xlCellTypeVisible).count > 1 Then
              .Rows(1).Hidden = True

                For Each Rg In .SpecialCells(xlCellTypeVisible).Areas
                    Rg(Application.Match(Application.Min(Rg), Rg, 0)).Offset(, 1).Value = "¤"
                Next
            Else
                .ShowAllData
            End If
        End With

        If .FilterMode Then
          .[BS2].Formula = "=BO2=""¤"""
          .Cells(1).CurrentRegion.AdvancedFilter xlFilterInPlace, .[BS1:BS2]
          .[_FilterDatabase].Columns(1).Copy .Cells(69)
          .ShowAllData
          .Activate:      ActiveWindow.ScrollRow = 1
        End If

        .[BS2].Clear
    End With
End Sub

Any thoughts please.

Thanks,

Ria

 

[Marc L]

When an error occurs on one of ShowData lines means there is no filter !
But 'cause original code works like a breeze on joined workbook …
No data ? Reference error in code ?

Progress in code via step by step mode with F8 key to try to find out …
​

 

[Marc L]

With Sheet2

.Cells(1) … means cell A1 where is Date on attached workbook …
​

 

[Ria]

With Sheet2

.Cells(1) … means cell A1 where is Date on attached workbook …
​

Hi Mark:
I stepped through, and it skips following lines of code and then shows error on .showAllData.

.Rows(1).Hidden = True

                For Each Rg In .SpecialCells(xlCellTypeVisible).Areas
                    Rg(Application.Match(Application.Min(Rg), Rg, 0)).Offset(, 1).Value = "¤"
                Next
            Else
                .ShowAllData

Everything is same beside cell reference.
Attached is new xl file, created based on actual cell references, however extra data/charts and sheets deleted. Bothering you last time, if you can make it working.
Regards

Ria

 

[Marc L]

As I wrote, a reference problem !
CurrentRegion works for continuous data without empty column or line …​

Sub Demo()
    Dim Rg As Range
    Application.ScreenUpdating = False

    With Sheet1
        .Columns("BO:BQ").Clear
        .[BS2].Formula = "=ISNUMBER(BN2)"
        .Cells(1).CurrentRegion.Resize(, 66).AdvancedFilter xlFilterInPlace, .[BS1:BS2]

        With .[_FilterDatabase].Columns("BN")
            If .SpecialCells(xlCellTypeVisible).Count > 1 Then
                .Rows(1).Hidden = True

                For Each Rg In .SpecialCells(xlCellTypeVisible).Areas
                    With Application:  Rg(.Match(.Min(Rg), Rg, 0))(1, 2).Value = "¤":  End With
                Next
            Else
                .ShowAllData
            End If
        End With

        If .FilterMode Then
            .[BS2].Formula = "=BO2=""¤"""
            .Cells(1).CurrentRegion.Resize(, 67).AdvancedFilter xlFilterInPlace, .[BS1:BS2]
            .[_FilterDatabase].Columns(1).Copy .[BQ1]
            .ShowAllData
            .Activate:      ActiveWindow.ScrollRow = 1
        End If

        .[BS2].Clear
    End With
End Sub

You like ? So thanks …
​

 

[Ria]

As I wrote, a reference problem !
CurrentRegion works for continuous data without empty column or line …​

Sub Demo()
    Dim Rg As Range
    Application.ScreenUpdating = False

    With Sheet1
        .Columns("BO:BQ").Clear
        .[BS2].Formula = "=ISNUMBER(BN2)"
        .Cells(1).CurrentRegion.Resize(, 66).AdvancedFilter xlFilterInPlace, .[BS1:BS2]

        With .[_FilterDatabase].Columns("BN")
            If .SpecialCells(xlCellTypeVisible).Count > 1 Then
                .Rows(1).Hidden = True

                For Each Rg In .SpecialCells(xlCellTypeVisible).Areas
                    With Application:  Rg(.Match(.Min(Rg), Rg, 0))(1, 2).Value = "¤":  End With
                Next
            Else
                .ShowAllData
            End If
        End With

        If .FilterMode Then
            .[BS2].Formula = "=BO2=""¤"""
            .Cells(1).CurrentRegion.Resize(, 67).AdvancedFilter xlFilterInPlace, .[BS1:BS2]
            .[_FilterDatabase].Columns(1).Copy .[BQ1]
            .ShowAllData
            .Activate:      ActiveWindow.ScrollRow = 1
        End If

        .[BS2].Clear
    End With
End Sub

You like ? So thanks …
​

Marc last code you posted, gives error message:
Runtime error 1004.
Copy method of range class failed.

 

[Marc L]

Well works on my side under Excel 2003 with your attached file TestHelp2 …
Like a breeze !

Progress in code via step by step mode by hitting F8 key
to find out where error occurs …
​

 

[Ria]

Well works on my side under Excel 2003 with your attached file TestHelp2 …
Like a breeze !

Progress in code via step by step mode by hitting F8 key
to find out where error occurs …
​

Thanks Marc.
Found the way to work around. You are great man.

Ria

 

[Marc L]

What was the issue ?

Do you really need a sign near each area min value or just final output ?
​

 

[Ria]

What was the issue ?

Do you really need a sign near each area min value or just final output ?
​

Just final out put is good enough.

Again thanks.

Ria

 

[Marc L]

Based on TestHelp2 without any sign :​

Sub Demo2()
    Application.ScreenUpdating = False

    With Sheet1
        .[BQ1].CurrentRegion.Clear
        .[BS2].Formula = "=ISNUMBER(BN2)"
        .Cells(1).CurrentRegion.Resize(, 66).AdvancedFilter xlFilterInPlace, .[BS1:BS2]
        .[BS2].Clear

        With .[_FilterDatabase].Columns("BN")
            If .SpecialCells(xlCellTypeVisible).Count > 1 Then
                .Rows(1).Hidden = True

                With .SpecialCells(xlCellTypeVisible).Areas
                    C& = .Count:  ReDim DT(1 To C, 0)

                    For R& = 1 To C
                        DT(R, 0) = .Item(R)(Application.Match(Application.Min(.Item(R)), .Item(R), 0), -64).Value
                    Next
                End With
            End If
        End With

        If .FilterMode Then .ShowAllData
          If C Then .[BQ2].Resize(C).Value = DT
        .Activate:  ActiveWindow.ScrollRow = 1
    End With
End Sub

You like ? So thanks to …​

 

[Ria]

Based on TestHelp2 without any sign :​

Sub Demo2()
    Application.ScreenUpdating = False

    With Sheet1
        .[BQ1].CurrentRegion.Clear
        .[BS2].Formula = "=ISNUMBER(BN2)"
        .Cells(1).CurrentRegion.Resize(, 66).AdvancedFilter xlFilterInPlace, .[BS1:BS2]
        .[BS2].Clear

        With .[_FilterDatabase].Columns("BN")
            If .SpecialCells(xlCellTypeVisible).Count > 1 Then
                .Rows(1).Hidden = True

                With .SpecialCells(xlCellTypeVisible).Areas
                    C& = .Count:  ReDim DT(1 To C, 0)

                    For R& = 1 To C
                        DT(R, 0) = .Item(R)(Application.Match(Application.Min(.Item(R)), .Item(R), 0), -64).Value
                    Next
                End With
            End If
        End With

        If .FilterMode Then .ShowAllData
          If C Then .[BQ2].Resize(C).Value = DT
        .Activate:  ActiveWindow.ScrollRow = 1
    End With
End Sub

You like ? So thanks to …​

Thanks Marc. Really I do not have words to say thanks.
This last code works the way we need. At one situation (when we have time with date), previous code was not working. But this one is doing all.
Actually, I am not a programmer and mostly do and learn myself. When I am stuck then ask for help. Code I get in help, sometime easy for me to understand and make changes if we need to but sometime code is bit higher level and out of my skill level. That's why I asked you for clarification many times.
You are great programmer and again thanks.

Ria