Quantcast
Channel: Excel Help Forum - Excel Programming / VBA / Macros
Viewing all 50273 articles
Browse latest View live
↧

[SOLVED] Counting cells in a table row that have data

August 12, 2017, 10:13 pm
$
0
0
I have a table with three columns of varying number of rows of data that I'd like to combine into one other row. I've seen some vba code that will do this quite well with regular rows and columns but I happen to be using an Excel table and I've been unable to find a workable solution. One trouble I've had is counting the rows of data. With regular Excel tabular data it's pretty straightforward but I could find nothing on counting active rows in an Excel table. I'm open to using VBA or formulas in the table.

It's simply 3 rows of random data of varying length that I'm combining into one...attached is an example worksheet with a table that shows the results I'm trying to achieve.
Attached Files
↧
Search

show last modified date of a cell

August 12, 2017, 11:41 pm
$
0
0
Dear all,
i need a help that in my excell file how can i see the last modified date in a cell. that means if i select a cell i will see it last modified date & time.
Dear all Expert, please help me.
↧
↧

After running the following macro excel shows "out of memory"

August 13, 2017, 12:08 am
$
0
0
I have an excel workbook with 21 worksheets and 17 user form to input data into different worksheets. How can I overcome this problem. Please help me..

Code:
Private Sub BTN_add_Click()
Application.ScreenUpdating = False

    Dim lrow As Double
    lrow = ThisWorkbook.Worksheets("Info.").Cells(Rows.Count, 3).End(xlUp).Row
   
    If TextBox1.Value = "" Or ComboBox1.Value = "" Then
    MsgBox ("Please Fill All Informations"), vbInformation
    Exit Sub
    Else
    Cells(lrow + 1, 3).Value = TextBox1.Value
    Cells(lrow + 1, 4).Value = ComboBox1.Value
    Cells(lrow + 1, 5).Value = "CE, DUET"
    End If
    ComboBox1.Value = ""
    TextBox1.Value = ""

    Me.ListBox1.List = ThisWorkbook.Worksheets("Info.").Range(Cells(3, 3), Cells(lrow + 1, 5)).Value
    ThisWorkbook.Save

Application.ScreenUpdating = True
End Sub

Private Sub BTN_MoveSelectedLeft_Click()
   
    Dim IndexRow As Long
    Dim IndexCol As Long
   
    With ListBox2
        For IndexRow = 0 To .ListCount - 1
            If .Selected(IndexRow) Then
                ListBox1.AddItem .List(IndexRow, 0)
                For IndexCol = 1 To .ColumnCount - 1
                    ListBox1.List(ListBox1.ListCount - 1, IndexCol) = .List(IndexRow, IndexCol)
                Next
            End If
        Next
 
    End With
    For IndexRow = Me.ListBox2.ListCount - 1 To 0 Step -1
        If Me.ListBox2.Selected(IndexRow) = True Then
            Me.ListBox2.RemoveItem IndexRow
        End If
    Next IndexRow


End Sub

Private Sub BTN_MoveSelectedRight_Click()
Dim res As Integer


res = MsgBox("Please Add/Update Teacher's Name, Designation and Address before Moving Informations. Do you want to Proceed?", vbYesNo + vbDefaultButton2 + vbInformation, "Add/Update Informations")

Select Case res
        Case vbNo

Exit Sub
        Case vbYes
Dim IndexRow As Long
Dim IndexCol As Long
    With ListBox1
        For IndexRow = 0 To .ListCount - 1
            If .Selected(IndexRow) Then
                    ListBox2.AddItem .List(IndexRow, 0)
                For IndexCol = 1 To .ColumnCount - 1
                    ListBox2.List(ListBox2.ListCount - 1, IndexCol) = .List(IndexRow, IndexCol)
                Next
            End If
        Next

    End With
    For IndexRow = Me.ListBox1.ListCount - 1 To 0 Step -1
        If Me.ListBox1.Selected(IndexRow) = True Then
            Me.ListBox1.RemoveItem IndexRow
        End If
    Next IndexRow
End Select

End Sub

Private Sub BTN_Update_Click()
Application.ScreenUpdating = False

Dim iCtr As Long
Dim lrow As Double
    lrow = ThisWorkbook.Worksheets("Info.").Cells(Rows.Count, 3).End(xlUp).Row

    For iCtr = 0 To Me.ListBox1.ListCount - 1
        If Me.ListBox1.Selected(iCtr) = True Then
        Cells(iCtr + 3, 3).Value = TextBox1.Value
        Cells(iCtr + 3, 4).Value = ComboBox1.Value

        End If
    Next iCtr
    Me.ListBox1.List = ThisWorkbook.Worksheets("Info.").Range(Cells(3, 3), Cells(lrow, 5)).Value
    Me.ListBox1.MultiSelect = fmMultiSelectMulti
    ComboBox1.Value = ""
    TextBox1.Value = ""
    ThisWorkbook.Save

Application.ScreenUpdating = True
End Sub

Private Sub cmb_delete_Click()
Application.ScreenUpdating = False

    ListBox1.RemoveItem (ListBox1.ListIndex)
    Range(Cells(3, 3), Cells(ListBox1.ListCount + 2, 5)).Value = ListBox1.List
    Range(Cells(ListBox1.ListCount + 3, 3), Cells(ListBox1.ListCount + 3, 5)) = ClearContents

Application.ScreenUpdating = True
End Sub

Private Sub Cmb_Home_Click()
Unload CE_TL
Home.Show
End Sub

Private Sub Cmb_Next_Click()
Application.ScreenUpdating = False
Dim iCtr As Long

If ListBox2.ListCount = 0 Then
MsgBox ("Please Fill the Active Teacher's List"), vbInformation + vbOKOnly
Exit Sub
Else
    Range(Cells(3, 37), Cells(203, 39)) = ClearContents
    iCtr = Me.ListBox2.ListCount
    Range(Cells(3, 37), Cells(iCtr + 2, 39)).Value = ListBox2.List
    Range(Cells(3, 37), Cells(iCtr + 2, 39)).Name = "CETL"
End If

ThisWorkbook.Save
Unload CE_TL

Application.ScreenUpdating = True

Dim xconnection As Object
For Each xconnection In ActiveWorkbook.Connections
If xconnection.Name <> "ThisworkbookDataModal" Then
xconnection.Delete
End If
Next xconnection

Math_TL.Show

End Sub

Private Sub Cmb_Previous_Click()
Unload CE_TL
Home.Show
End Sub

Private Sub ListBox1_dblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim iCtr As Long

    For iCtr = 0 To Me.ListBox1.ListCount - 1
        If Me.ListBox1.Selected(iCtr) = True Then
            TextBox1.Value = ListBox1.List(iCtr)
            ComboBox1.Value = ListBox1.List(iCtr, 1)
        End If
    Next iCtr
    Me.ListBox1.MultiSelect = fmMultiSelectSingle
End Sub

Private Sub UserForm_Initialize()
ThisWorkbook.Worksheets("Info.").Activate
ComboBox1.Value = ""
TextBox1.Value = ""

    Dim lrow As Double
    lrow = ThisWorkbook.Worksheets("Info.").Cells(Rows.Count, 3).End(xlUp).Row
    Me.ListBox1.Clear
    Me.ListBox2.Clear
    Me.ListBox1.List = ThisWorkbook.Worksheets("Info.").Range(Cells(3, 3), Cells(lrow, 5)).Value
'    Me.ListBox1.MultiSelect = fmMultiSelectMulti
'    Me.ListBox2.MultiSelect = fmMultiSelectMulti

End Sub

Private Sub ListBox1_MouseMove( _
                        ByVal Button As Integer, ByVal Shift As Integer, _
                        ByVal X As Single, ByVal Y As Single)
        HookListBoxScroll Me, Me.ListBox1
End Sub

Private Sub ListBox2_MouseMove( _
                        ByVal Button As Integer, ByVal Shift As Integer, _
                        ByVal X As Single, ByVal Y As Single)
        HookListBoxScroll Me, Me.ListBox2
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
        UnhookListBoxScroll
End Sub
↧

Filter Data and Format Results - VBA

August 13, 2017, 1:23 am
$
0
0
Hi All,

Needed to read through multiple files, combine files and finally format data it in a specified format.

I am able to combine the individual files and create a final XL, but unable to filter data and apply the data.

Filter-Data.PNG

Tried to record a macro but did not achieve the result.

- Thanks
Attached Files
↧

VBA to Paste a HYPERLINK to a cell without changing the cell content.

August 13, 2017, 3:01 am
$
0
0
I need to link a large number of hyperlinks to certain cells I choose and have tried to create a VBA macro to do this.

I have copied a hyperlink from a source and then need to Paste that link into a cell without it changing the cell content.
I have tried different PasteSpecial extensions but not been able to resolve this issue. Can someone suggest a way of doing this please.
↧
↧

[SOLVED] vba code to change font failed to work properly

August 13, 2017, 6:47 am
$
0
0
I have a worksheet called summary csv but need to change from calibri to arial with a font 8 TO 12 to last data row

As per attached , the range is not continious , the column C to be formatted as text.

But so far it failing to work properly



Code:

Sub Worksheet_Font_Change1()

        With Sheets("final csv").Range("A1:M1" & Lastrow)
        Range("C").NumberFormat = "@"
            With .font
                .Name = "Arial"
                .FontStyle = "Regular"
                .Size = 12
            End With
              End With
End Sub
Attached Files
↧

Sorting Unique ids

August 13, 2017, 6:53 am
$
0
0
Hi friends,

i have suffered with extract maximum values from each unique id. each unique id having different values.
from master workbook i want extract values to another excel workbook. so please provide suitable code.
From master workbook i need B, D, F, G, J, K, O. here B, D, & T are unique.
and required maximum values from each F, G, J, K, O columns.

i have prepared Unique template worksheet book model. so After open template sheet, select master sheet and import (paste) to Unique work book.

Please find sample Master workbook and unique workbook.

Thanks,
Best Regards.
Attached Images
Attached Files
↧

Need to hide row in sheet from ComboBox selection

August 13, 2017, 7:12 am
$
0
0
Hello All,

I have this code for ComboBox and I am not able to get it to hide a row based on the selection made

Here is the worksheet - any help would be great

Code:
Private Sub ComboBox1_Click()
Dim tmpR As Range
Set tmpR = Range("A4:A100" & Range("A100").End(xlUp).Row)
tmpR.EntireRow.Hidden = False
Set fx = tmpR.Find(ComboBox1.Text)
If fx Is Nothing Then Exit Sub

f = tmpR.Find(ComboBox1.Text).Address
nxt = tmpR.FindNext.Address
While nxt <> f
Str1 = nxt & ","
nxt = tmpR.FindNext.Address
Wend

Str1 = f & "," & Str1
Str1 = Left(Str1, Len(Str1) - 1)
Sheet1.Range(Str1).EntireRow.Hidden = True
End Sub


Best Regards,

John
↧
Search

Automating Graphs in Excel

August 13, 2017, 7:19 am
$
0
0
Hello All,

I have some tasks that I run manually every time I run my models and was hoping to automate some of them. Once the model is run, it generates some graphs, I would to automate the following functions:
- Create a pivot chart per filter item
- Change Title of chart to Selection on Filter
- Change the axis ratio to be as close to a number as possible (by increments of .5)
- in example, the secondary axis is 7 and the primary is 600. The ratio of those is ~85, and the benchmark on the previous tab is 88. Ideally each graph generated would have to be edited to come close to that ratio


Thank you!
Attached Files
↧
↧

[SOLVED] Run macro on leaving cell

August 13, 2017, 8:34 am
$
0
0
What I am trying to do is remind the user to enter a payment date after entering a payment. I found this bit of code that does the job, triggers a message on any cell change.

I would like to change it so that the message is triggered only if a number is entered in "INSPAY". It is being triggered now when I add a new line and the formula in INSPAY is copied down, a bit of a nuisance.

Here is my code:

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCells As Range

    ' The variable KeyCells contains the cells that will
    ' cause an alert when they are changed.
    Set KeyCells = Range("INSPAY")
   
    If Not Application.Intersect(KeyCells, Range(Target.Address)) _
          Is Nothing Then

        ' Display a message when one of the designated cells has been
        ' changed.
        ' Place your code here.
        MsgBox "ENTER INS PAY DATE"
     
    End If
End Sub
Thanks
↧

Open word doc rather than create new document - change to existing VBA

August 13, 2017, 10:56 am
$
0
0
Hi all

I'm trying to amend this macro so that rather than create a new word document from the path name, it instead just opens up the actual document in the path name and makes the changes.

I am happy with the path it currently uses (since it searches for the named doc within the code in the same path as the workbook) this is perfect for my needs. But I would much prefer that it opens the document in question and then does it work of inserting data into bookmarks.

Can anyone help? Having spent a few hours on it today I'm struggling to get it working. Any help appreciated!


Code:
Option Explicit

Sub Reportcreatebutton2()
Dim pappWord As Object
Dim docWord As Object
Dim wb As Excel.Workbook
Dim xlName As Excel.Name
Dim TodayDate As String
Dim Path As String

  Set wb = ActiveWorkbook
  TodayDate = Format(Date, "mmmm d, yyyy")
  Path = wb.Path & "\Test1.docm"
 
  On Error GoTo ErrorHandler

'Create a new Word Session
  Set pappWord = CreateObject("Word.Application")
 
  On Error GoTo ErrorHandler

'Open document in word
  Set docWord = pappWord.Documents.Add(Path)

'Loop through names in the activeworkbook
  For Each xlName In wb.Names
    'if xlName's name is existing in document then put the value in place of the bookmark
    If docWord.Bookmarks.Exists(xlName.Name) Then
      docWord.Bookmarks(xlName.Name).Range.Text = Range(xlName.Value).Text
    End If
  Next xlName

'Activate word and display document
  With pappWord
      .Visible = True
      .ActiveWindow.WindowState = 0
      .Activate
  End With

'Release the Word object to save memory and exit macro
ErrorExit:
  Set pappWord = Nothing
  Exit Sub

'Error Handling routine
ErrorHandler:
  If Err Then
      MsgBox "Error No: " & Err.Number & "; There is a problem"
      If Not pappWord Is Nothing Then
        pappWord.Quit False
      End If
      Resume ErrorExit
  End If
End Sub
↧

vba to copy specific sheet to new workbook based on a cell value

August 13, 2017, 11:07 am
$
0
0
I have a workbook with lot of sheets, the final csv sheet will be always the last sheet.

Trying to copy the final csv sheets only, add new workbook with one sheet only and save the file based on cell B1 in csv ms dos format but unsuccesful .

Code:

Sub copycsv()

Sheets("FINAL Csv").Copy
Application.DisplayAlerts = False ' suppress overwrite warning message
 ChDir "C:\Users\user\Desktop"
ActiveWorkbook.SaveAs Filename:="C:\Users\user\Desktop\" & Range("B1"), _
 FileFormat:=xlCSVMSDOS, CreateBackup:=False
Application.DisplayAlerts = True
ActiveWorkbook.Close SaveChanges:=False

End Sub
Attached Files
↧

deleting word bookmarks from excel - change to existing code

August 13, 2017, 1:21 pm
$
0
0
Hi,

I have some code which is working perfectly within excel to paste data into word. I'm now just looking to add deletion of bookmarks at the end of the code, so the last process undertaken after the data has been pushed into word is that the bookmarks are deleted (Not the text, just the reference point).

I've found some bookmark deletion code which works in word (and it keeps the text) and done some researching but can't find how to add it and get it working. Hopefully this will be an easy one for your expert standards!

Any help greatly appreciated.

Code:
Option Explicit

Sub Reportcreatebutton2()
Dim pappWord As Object
Dim docWord As Object
Dim wb As Excel.Workbook
Dim xlName As Excel.Name
Dim TodayDate As String
Dim Path As String

  Set wb = ActiveWorkbook
  TodayDate = Format(Date, "mmmm d, yyyy")
  Path = wb.Path & "\Report Draft V1.docm"
 
  On Error GoTo ErrorHandler

'Create a new Word Session
  Set pappWord = CreateObject("Word.Application")
 
  On Error GoTo ErrorHandler

'Open document in word
Set docWord = pappWord.Documents.Open(Path)

'Loop through names in the activeworkbook
  For Each xlName In wb.Names
    'if xlName's name is existing in document then put the value in place of the bookmark
    If docWord.Bookmarks.Exists(xlName.Name) Then
      docWord.Bookmarks(xlName.Name).Range.Text = Range(xlName.Value).Text
    End If
  Next xlName

'Activate word and display document
  With pappWord
      .Visible = True
      .ActiveWindow.WindowState = 0
      .Activate
  End With

'Release the Word object to save memory and exit macro
ErrorExit:
  Set pappWord = Nothing
  Exit Sub

'Error Handling routine
ErrorHandler:
  If Err Then
      MsgBox "Error No: " & Err.Number & "; There is a problem"
      If Not pappWord Is Nothing Then
        pappWord.Quit False
      End If
      Resume ErrorExit
  End If
End Sub
and here is the bookmark deletion code that deletes the bookmark but not the text

Code:
    Dim objBookmark As Bookmark

    For Each objBookmark In ActiveDocument.Bookmarks
        objBookmark.Delete
    Next
↧
↧

Copying User Input from One Worksheet to Another

August 13, 2017, 2:58 pm
$
0
0
Hello All,

I'm trying to code to automatically copy the user input from one sheet to another sheet. Three of the options the user has to choose from contains a list. So if the user selects A,B, or C then the code would copy the lists to the Optional tab and then the code would just loop through the Main worksheet and copy whatever the user inputs to the next available cell in the Optional cell.

I hope this makes sense. I attached the excel file.
Attached Files
↧

[SOLVED] Save as PDF with file name set to date and time it was saved

August 14, 2017, 10:07 am
$
0
0
Good Afternoon all

I have the following code that will save my active sheet as a PDF and name that file Test but what i really want is to save the file as the date and time it was saved. I need it to save sheet8 really not the Active sheet as i cant guarantee sheet8 will be active.

Code:
Sub SAVE()
'
' SAVE Macro
'

'
    ChDir "C:\Users\e81385\Desktop\SIC"
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        "C:\Users\e81385\Desktop\SIC\Test.pdf", Quality:= _
        xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
End Sub
↧
Search

Update list of files

August 14, 2017, 10:35 am
$
0
0
With this macro, I can list files in a selected directory.
In the spreadsheet, there already exists a list created previously.
Currently, the macro asks which rows to delete before it re-writes the total list of files (this is done because the list changes frequently).
What I want to do instead, is select a range and then apply an update (add if new, nothing if it exists, delete if not there anymore).
There will be data above and below, so additions/subtractions need add/delete row.
Will this be possible?

Code:
Dim Row As Long

Sub File_list()
    Dim rRange As Range
    Dim sFolder As FileDialog
    On Error Resume Next
    Set rRange = Application.InputBox(Prompt:="Select rows to delete", Title:="Replacing?", Type:=8)
    With rRange
        .Offset(0, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    End With
    Set sFolder = Application.FileDialog(msoFileDialogFolderPicker)
    If sFolder.Show = -1 Then
        Row = 0
        File_Details_List_Files sFolder.SelectedItems(1), True
    End If
End Sub

Private Sub File_Details_List_Files(ByVal SourceFolderName As String, ByVal IncludeSubfolders As Boolean)
    Dim FSO As Object
    Dim SourceFolder As Object
    Dim FileItem As Object
    Dim strFile As String
    Dim FileName As Variant
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set SourceFolder = FSO.GetFolder(SourceFolderName)
    If Row = 0 Then Row = ActiveCell.Row
    With CreateObject("Scripting.Dictionary")
        For Each FileItem In SourceFolder.Files
            strFile = FileItem.Name
            .Item(strFile) = Array(FileItem.Name)
        Next FileItem
        If .Count > 0 Then
            For Each FileName In .Items
                Rows(Row).Insert
                Cells(Row, 1).Formula = FileName
                Row = Row + 1
            Next FileName
        End If
    End With
    Set FileItem = Nothing
    Set SourceFolder = Nothing
    Set FSO = Nothing
End Sub
↧

Combox list with Collection, list getting updated multiple time

August 14, 2017, 10:41 am
$
0
0
Hello Experts,
I have created combo box with using of collection, I have list a (data) in sheet1 range("A1") to Last row (variable). I have added combo-box item with collection.

I am facing issue the number of time I click on Drop down of combo-box the list is updating that number of time.

Please help me to resolve this. I am new to VBA.

Thanks an regards.

upguy
Attached Files
↧
↧

Empty Global Array

August 14, 2017, 10:56 am
$
0
0
I'm not really sure what the best way to declare global or public variables is, but I've declared a public array in a module as shown in the picture below. However, when my sub is executed, it says my public array "Pattern" is empty. What am I doing wrong?

excel.png
↧

Zoom in through MouseOver

August 14, 2017, 11:06 am
$
0
0
Dears good afternoon
I would like to know if someone can help me on this matter.
I have created a dashboard with different information. but on the left side of my worksheet, due to the quantity of charts I have, I had to reduce them to get all the chart on the same place.

Because, it is not clear enough when you are analyzing the chart, I am looking for a way to get the chart bigger.
For that I was wondering if it is possible hrough a MouseOver to get the chart bigger, showing legend, title and so on.

Enclosed you will find my file and also a picture of what I am looking for.
I am working with Excel 2013.

Waiting for your feedback
Regards
Attached Images
Attached Files
↧

[SOLVED] How to Call an userform's Control with its name stored in a worksheet

August 14, 2017, 11:30 am
$
0
0
Hello,

1. on sheets(1), cells("A1") has the name of a combobox "cbx_test" .
2. on a userform1, I have created a combo called "cbx_test".

With VBA, when Userform1 initialise, I try to call the combobox with the value stored in "A1"

something like (this actual code doesn't work)

Code:
Private Sub UserForm_Initialize()

with sheet(1).range("A1").Value '="cbx_test"
  .AddItem "banana"
end with

End sub
Thank you
↧
Viewing all 50273 articles
Browse latest View live
Search

Latest Images

7 clever tricks Primark does to keep you walking & buying more than you need...

7 clever tricks Primark does to keep you walking & buying more than you need...

July 20, 2025, 5:14 am
Art for Everyone! Autism advocacy, local stories, and indigenous pride in one...

Art for Everyone! Autism advocacy, local stories, and indigenous pride in one...

July 20, 2025, 5:06 am
Paintings of English Downs 2

Paintings of English Downs 2

July 20, 2025, 4:30 am
How Kerala Women Rescued a Dying Forest and Turned It Into a Safe Haven for...

How Kerala Women Rescued a Dying Forest and Turned It Into a Safe Haven for...

July 20, 2025, 3:30 am
Met Eireann warns of heavy rain & spot flooding for DAYS before big...

Met Eireann warns of heavy rain & spot flooding for DAYS before big...

July 20, 2025, 1:14 am
Who is Kevin Lerena’s wife Geraldine?

Who is Kevin Lerena’s wife Geraldine?

July 20, 2025, 12:57 am
Man stabs woman, baby to death inside Queens home, police say

Man stabs woman, baby to death inside Queens home, police say

July 19, 2025, 11:00 pm
Ang papel ni whistleblower Julie Patidongan sa kaso ng mga nawawalang sabungero

Ang papel ni whistleblower Julie Patidongan sa kaso ng mga nawawalang sabungero

July 19, 2025, 9:45 pm
Telangana Human Rights Commission (TGHRC) seeks report from revenue dept on...

Telangana Human Rights Commission (TGHRC) seeks report from revenue dept on...

July 19, 2025, 7:29 pm
Crisis-hit NHS fat cats raking in MASSIVE salaries as frontline services cry...

Crisis-hit NHS fat cats raking in MASSIVE salaries as frontline services cry...

July 19, 2025, 2:11 pm