Posts by Maqbool

Hi Mrgibr:

Try the following on your sample workbook. If works as expected you can apply it on your original file.

Public strWbName As String
Sub ttest()
    Dim ws As Worksheet
    Dim pvtTbl As PivotTable
    Dim pvtFld As PivotField
    Dim pvtitm As PivotItem
    Set ws = ThisWorkbook.Sheets("Summary")
    
    Application.ScreenUpdating = True
    With ws
        Set pvtTbl = .PivotTables(1)
    End With
    
    With pvtTbl
        .ClearAllFilters
        Set pvtFld = .PivotFields(1)
            
        j = pvtFld.PivotItems.Count
        k = 1
        
        For x = j To 1 Step -1
            a = pvtFld.PivotItems(x)
            If a <> "(blank)" Or x <> 1 Then  ' change accordingly
                pvtFld.PivotItems(x).Visible = False
            End If
        Next
                
        
        For x = 1 To j
            If x = j Then Exit Sub
            
            pvtFld.PivotItems(x + 1).Visible = True
            pvtFld.PivotItems(x).Visible = False
            strWbName = pvtFld.PivotItems(x + 1)


            CreateWb
        Next
            
            
      End With
    
     Application.ScreenUpdating = True
End Sub


Sub CreateWb()
    Dim wsMain As Worksheet
    Dim wbNw As Workbook
    Dim wbMain As Workbook
    Dim rngToCpy
    strpath = "C:\D-Drive\SET 1\"
    Set wbMain = ThisWorkbook
    Set wbNw = Workbooks.Add
    Application.ScreenUpdating = False
    
    With wbMain
        Set wsMain = .Sheets("Summary")
    End With
    
    With wsMain
        x = .Rows.Count
        Set rngToCpy = .Range("B2", .Range("B" & x).End(xlUp).Offset(0, 1))
        .Activate
        rngToCpy.Copy
    End With
        
    With wbNw.Sheets("Sheet1")
        .Range("A1").PasteSpecial xlValues
        .Range("A1").PasteSpecial xlFormats
        .Columns.AutoFit
        Application.CutCopyMode = False
    End With
    
    wbNw.SaveAs strpath & strWbName
   wbNw.Close True
    
    Application.ScreenUpdating = True
    


End Sub

Regards

Maqbool

Hi

Your column B values stored the time value as text.
To understand it easily - on next column (E) you try the formula =value(B2) and change the format to number.
The macro does the same thing. Take the value in the cell and place it back as value. Since your cells are already formatted "Custom" - it does not need further formatting.

I dont think i understand your second question: If i am not mistaken;

.Cells(i, 2).Value = .Cells(i, 2).Value  'column b  
 .Cells(i, 4).Value = .Cells(i, 4).Value  'column d

Regards Maqbool

Hi
If your data is exactly same as on the spreadsheet attached, the following will work.

Sub formaterTid()
Dim ws1 As Worksheet, i As Integer, lr As Long
Dim curText As Long


Set ws1 = Sheet1
lr = ws1.Cells(Rows.Count, 1).End(xlUp).Row


    With ws1
        For i = 2 To lr
            .Cells(i, 2).Value = .Cells(i, 2).Value
        Next i
    End With
    
End Sub

Regards

Maqbool

Hi

On BLD, column B looks like in text format. Seems you are exporting the data from somewhere.

Select the cell (eg B2) then press "F2" and press "Enter". You will notice that the value in B2 will move to the right hand side of the cell. Then try to run the macro. It will work.

Regards

Maqbool

Hi

Try the following code. This will save all tables as picture (JPG) on a worksheet. You can modify the according to your needs.

Sub CopyPaste()
    Dim ws As Worksheet
    Dim obj As ListObject
    Dim strPath As String
    Dim shtChart As Chart
    
    strPath = "C:\MyDocs\"
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Set ws = Sheets("Sheet1")
    x = 1
    
    With ws
        For Each obj In .ListObjects
            a = obj.Name
            obj.Range.CopyPicture xlScreen, xlPicture
            Charts.Add
            Set shtChart = ActiveSheet
            shtChart.Paste
            shtChart.Export strPath & "Pic_" & x & ".JPG"
            shtChart.Delete
            x = x + 1
        Next
    
    End With
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

Regards

Maqbool

Re: Autofilter and copy the data to multiple workbooks and worksheets

Hi

Welcome to the forum.

Can you post a sample workbook. Also a workbook with expected result - say - for John only. Then I will have a look on it.

Regards

Maqbool

Re: Refreshing tables

Quote

The only real solution I've found is to use the ActiveWorkbook.RefreshAll function twice, which isn't speedy or elegant. Whilst I can get by, my I can't help but try and find the proper solution.

Try the below code:

Sub tttt()
    Dim ws As Worksheet
    Dim pvt As PivotTable
    Dim i As Integer
    
    
    For Each ws In ThisWorkbook.Sheets
        With ws
            i = .PivotTables.Count
            If i > 0 Then
               For Each pvt In .PivotTables
                    pvt.PivotCache.Refresh
               Next
            End If
        End With
    Next
    
End Sub

Regards

Maqbool

Re: Combobox and multi column value select

Hi

If I understand you correctly, change column count from 1 to 3 in combo box properties.

Best Regards

Maqbool

Re: Chart with Combobox that updates Data Source

Hi

Is it possible to show sample charts? - create it manually - I like to see the expected results when you select " Past week " or month or quarter. If so, post a sample workbook with charts as expected.

Regards

Maqbool

Re: i want a formula to look for the latest quantity remaining for shoes

Hi

try the below array formula:
[F]
SUMPRODUCT((A3:A10=MAX(IF($B$3:$B$10=F10,A3:A10)))*(B3:B10=F10),C3:C10)
[/F]

Where A3:A10 - date, B3:B10-items, C3:C10 is Quantity and F10 - Criteria.

Regards

Maqbool

Re: i want to lookup all toyata related data in interface sheet & fill dem in manifes

Hi

Try the below array formula: Please make sure all merged columns are un-merged. Otherwise you may need to adjust the last part (COLUMN()-COLUMN($C$23)+1) of the formula manually.

(I cant upload the workbook from here. Will upload it later today.

[F]
=IFERROR(INDEX(Table1[#All],SMALL(IF(Manifest!$F$20=Interface!$F$15:$F$17,ROW(Interface!$F$15:$F$17)),ROW()-ROW($D$23))-12,COLUMN()-COLUMN($C$23)+1),"")
[/F]

Regards

Maqbool

Re: Create Multiple Shapes in Column A and Add Hyperlink from Range in Column B

Hi

Try the following in the sample workbook you attached. You can modify the code as required.

Sub CreateHyPerLink()
Dim ws As Worksheet
Dim rng As Range
Dim shps As Shapes
Dim c As Range
Dim shp As Shape
Dim j As Integer
Dim strHLnk(100)




Set ws = ThisWorkbook.Sheets("Sheet1")


ws.Shapes.SelectAll


Selection.Delete
With ws
    i = .UsedRange.Rows.Count
    Set rng = .Range("B1:B" & i)
End With
j = 1
With rng
    For Each c In rng
        If c.Value <> "" Then
            shph = c.Height
            shpw = c.Width * 1.1
            shpTop = c.Top
            shpTop = c.Top + j
            ws.Shapes.AddShape msoShapeRectangle, 0, shpTop, shpw + 10, shph
            strHLnk(j) = c.Value
        End If
        j = j + 1
    Next
End With


    For Each shp In ws.Shapes
        With shp
              x = x + 1
             .TextFrame2.TextRange.Characters = "Open"
             .ShapeStyle = msoShapeStylePreset39
              ws.Hyperlinks.Add shp, strHLnk(x)
        End With
    Next
End Sub

Regards

Makbool

Re: Conditional Formatting with relative references

Hi

Try the to change your formula as below:

"=ISBlank(R[1]C4)=True"

Regards

Maqbool

Re: create ledger wise report by vba in excel

Hi Sachin_P

Welcome to the forum

Pretty easy to do with pivot tables. If you like to do it with a pivot please post a sample workbook.

Regards,

Makbool

Re: Auto filter a list with multiple criterias

Hey

Can you post a sample workbook with expected result. Your sample spreadsheet is confusing.

Regards

Maqbool

Re: Finding a DATE in a range of TEXT

Hi

I hope the following formula can do this. I am not completely understand your query. Please have a look.

I can't upload the excel file for some reason today. If you can IM your email id, i can send you the excel file. Otherwise, I will try again tomorrow.

=IF(AND(WEEKDAY(E9)<>{1,7},MOD(E9,1)>=$H$1,MOD(E9,1)<=$I$1)=TRUE,E9,IF(OR(WEEKDAY(E9)={1,7}),INT(E9)+IF(WEEKDAY(E9)=7,2,1)+$H$1,INT(E9)+$H$1))

Note: In this formula, I put 09:00 AM in H1 and 06:00 PM in I1.

The result will be look like the picture.

Best Regards

Makbool

Re: Finding a DATE in a range of TEXT

Hi:

Can you please upload an excel sheet with expected results.

Regards

Maqbool

Re: Finding a DATE in a range of TEXT

Hi tkaz4

Welcome to the forum

.

I assume you are trying to do look up of your date. Try below

MATCH(DateValue($C22),$A$5:$A$14,0)

Otherwise post a sample workbook.

Regards,

Makbool

Re: VBA Find next empty cell in range or named range

Hi..

Sorry for the late reply.

Yes, you can:

dim Irw as long

regards

Maqbool

Re: VBA Find next empty cell in range or named range

Hi

I can not upload the sample from my office pc. Following is the code to do the same. I believe you will always have a value in cell A62 (otherwise this will code will not work).

Private Sub CommandButton1_Click()
    Dim ws As Worksheet
    Dim cToInsert As Range
    Dim txtVal As String
    Set ws = ThisWorkbook.Sheets("SC CC")
    
    With ws
         txtVal = Me.TextBox1.Value
        Irw = .Rows.Count
        Set cToInsert = .Range("A" & Irw).End(xlUp).End(xlUp).Offset(1, 0)
        MsgBox cToInsert.Address
        cToInsert.Value = txtVal
    End With
    
End Sub

Regards

Maqbool