User Login

TipidPC.com is the largest online IT Community in the Philippines. Have something to sell or share? Sign up for an account now. It's absolutely free!

Forum Topic

excel macro programming

  • xxiidark Send Message View User Items on July 17, 2014 09:04 AM

    Paki explain mo nga ano ito, ngtututs, T.T?
    ngtututs kc ako now pero ngruruntime error 9 kc. dndeclare pb sa module yun pg tawag sa sheets. T.T

    Also anong ginagawa ng macro mo? Copy sheet1, sheet2 and sheet3 all to sheet4, isang workbook or file lang ba ito? o dalawa? one from sister company at yong isa sa main?

    -- edited by ram2010 on Jul 17 2014, 01:24 PM
  • ahm ganito po sir yung ngtuturs tutorial po hehehe sorry.

    isang workbook lang po ito.. ano ba mas madali magkakahiwaly ng workbook?.
    ito po example sir.
    ito po yung mga sister company.
    bendai,audi,basicwear. bale 3 sheet po sila and yung pang 4 sheet name is final.
    so gusto ko po sana si bendai,audi,basicwear ay magmemerge po ky final (sheet4) mgsosort po sya and mgtototal.
    possible po ba? thanks po sir ^^
  • Good Day TPC'er,

    Pa help naman - Sorting / re-grouping in another work book.

    details:
    First request:
    - file name: May 16-31 2014.xlsx
    - raw data under "Data File" then need to regroup to another sheet called "Per Name"
    - twist dito is dapat per transaction ng isang name is meron total based on "Actual Pay computation"
    - done.
    - See example in link below.

    Second request:
    - after regrouping, need ko itransfer per name sa isang workbook.
    - twist again, ung file name is kailangan is "Pay confirmation - Name (May16-31 2014) ex. Pay confirmation - Larry Benigno (May 16-31 2014)
    - kung ilan ung name un din ung dami nung file, hanggang sa matapos.

    Hindi ko kasi xa magawa need ko pa talaga mag-aral ng ng excel prog. Sana matulungan nyo ko.


    Here's the link para mas clear (final output): https://drive.google.com/folderview?id=0B_Vrkz2MJm5mcVlKSmR1VHAyWDg&usp=sharing

    TIA!
  • xxiidark Send Message View User Items on July 17, 2014 01:38 PM
    ahm ganito po sir yung ngtuturs tutorial po hehehe sorry.

    isang workbook lang po ito.. ano ba mas madali magkakahiwaly ng workbook?.
    ito po example sir.
    ito po yung mga sister company.
    bendai,audi,basicwear. bale 3 sheet po sila and yung pang 4 sheet name is final.
    so gusto ko po sana si bendai,audi,basicwear ay magmemerge po ky final (sheet4) mgsosort po sya and mgtototal.
    possible po ba? thanks po sir ^^

    Pag isang workbook lang mas ok sya kasi isang file lang ang e open mo at manipulate ka na lang sa sheets.
    Pwede itong gawan ng macro, pero dapat uniform ang formats sa supplied 3 sheets, para hindi complicated ang macro.
    Same column kung saan kunin ang total, at at what column mag sort ng data. Madali itong e manual, unless ina update ang 3 sheets
    every hour or less.

    -- edited by ram2010 on Jul 17 2014, 03:08 PM
  • ah oky ty sir.
    ito po kc format sir
    Name Salary ERShare EEShare Total.
    yung isosort ko po yung name.
    possible po ba na si name pg nasort lahat ng nsa column nya masasama din sa pagsosort?
    thanks ^^
  • Before sorting, select all data, then sort it by name for example, all data in other columns will follow doon sa sorted name column.
  • @ sir Ram and khedfreck thanks po sa help niyo.

    what if for example. iba ibang klase ng text style siya pero yung gusto ko lang maextract po is yung number. for ex:

    Cell A
    asdasd 1230 sdad
    da 3450 sd
    a 6780 b
    dsd sdsd 9101
    asd sdsd 9888 asd sds

    Cell B (results)
    1230
    3450
    6780
    9101
    9888

    -- edited by Dstar015 on Jul 17 2014, 05:20 PM
  • @ sir Ram and khedfreck thanks po sa help niyo.

    what if for example. iba ibang klase ng text style siya pero yung gusto ko lang maextract po is yung number. for ex:

    Cell A
    asdasd 1230 sdad
    da 3450 sd
    a 6780 b
    dsd sdsd 9101
    asd sdsd 9888 asd sds

    Cell B (results)
    1230
    3450
    6780
    9101
    9888

    Yong nasa Cell A, pwede mo itong gamitan ng text to column such that mahihiwalay sila per line. Saka mo na e extract ang number doon sa mga individual cells. Once ma extract na ang mga numbers, pwede mo na uli itong e combine sa isang cell.

    Hindi ito madali, pero pwede siyang gawan ng paraan.

    Pag marami ang mga ito, macro na lang siguro.
  • johnToT Send Message View User Items on July 17, 2014 01:40 PM
    Good Day TPC'er,

    Pa help naman - Sorting / re-grouping in another work book.

    details:
    First request:
    - file name: May 16-31 2014.xlsx
    - raw data under "Data File" then need to regroup to another sheet called "Per Name"
    - twist dito is dapat per transaction ng isang name is meron total based on "Actual Pay computation"
    - done.
    - See example in link below.

    Second request:
    - after regrouping, need ko itransfer per name sa isang workbook.
    - twist again, ung file name is kailangan is "Pay confirmation - Name (May16-31 2014) ex. Pay confirmation - Larry Benigno (May 16-31 2014)
    - kung ilan ung name un din ung dami nung file, hanggang sa matapos.

    Hindi ko kasi xa magawa need ko pa talaga mag-aral ng ng excel prog. Sana matulungan nyo ko.


    Here's the link para mas clear (final output): https://drive.google.com/folderview?id=0B_Vrkz2MJm5mcVlKSmR1VHAyWDg&usp=sharing

    TIA!

    Naintindihan ko ang gusto mong mangyari, I will create such a macro, but not sure about the time.
  • @ ram2010

    Thanks Ram,

    kahit simple macro lang - lam ko complicated and may kahirapan xa gawin, Basta maraming salamat, any help and effort is really appreciated and thanks for your time answering may post :)

    again many thanks :)
  • johnToT Send Message View User Items on July 18, 2014 12:33 PM
    @ ram2010

    I have completed the macro for creating files. I tested this and it worked.

    Create a module and paste the macro below to the file you uploaded. The active sheet should be the "per name" before running this macro.
    If you found problems saving this macro I will send the excel file where this macro is already saved.

    A bit complicated since while looping thru the main sheet searching for name and total, you have to change focus and paste the data of a new file created then loop again on the main sheet searching for other names for saving. See some comments in macro, you can uncomment the msgbox I commented if you want to see the process.

    There are limits in the macro, for scanning the rows and loops you can increase those if needed. The created files will be in the location where your main file is located. This is displayed in the msgbox when you start running the macro.


    Sub create_files()
    ' This macro will create and save files based on the data
    ' in the active sheet. The range to be saved in individual files
    ' are marked from "KeyDevID" to "TOTAL" in this sheet.

    Dim mainFilePath As String
    Dim mainWorkSheetName As String

    Dim title As String
    Dim name As String
    Dim filename As String
    Dim xfilename As String

    Dim r As Integer, c As Integer, r1 As Integer, c1 As Integer
    Dim f As Boolean
    Dim limit As Integer, maxLimit As Integer, maxRow As Integer

    limit = 0
    maxLimit = 1000
    maxRow = 1000

    r = 0

    ' Location of this file
    mainFilePath = Application.ActiveWorkbook.Path
    MsgBox "This file is located in: " & mainFilePath & ". New files will also be created in this path."

    mainWorkSheetName = ActiveSheet.name
    MsgBox "Active sheet name is: " & mainWorkSheetName

    ' Outside loop to check name and total, this is done since
    ' the macro changes from main workbook to created workbook
    Do While (limit < maxLimit)

    ' Flag if we found a name and a total
    f = False

    ' Debug
    'MsgBox "The Value of overall incrementer r after the do-while loop is " & r

    'loop thru the rows in column B
    For x = r + 1 To maxRow

    v = Cells(x, 2).Value
    If v = "KeyDevID" Then
    r = x
    c = 2

    ' Debug
    'MsgBox "We found a " & Cells(r, c).Value & " at row " & x

    ' Continue to search and find "TOTAL" with offset 27 from column 2
    For y = x + 1 To maxRow
    v1 = Cells(y, 2).Offset(0, 27).Value
    If v1 = "TOTAL" Then
    r1 = y
    c1 = 29

    ' Debug
    'MsgBox "We found a total of " & Cells(r1, c1).Offset(0, 2).Value

    f = True
    Exit For

    End If

    Next y

    If f Then
    Exit For
    End If

    End If

    Next x

    If f Then

    title = "Pay confirmation - "
    name = ActiveSheet.Cells(r + 1, 3)

    ' Debug
    MsgBox "Name: " & name & ", Total: " & Cells(r1, c1).Offset(0, 2).Value

    filename = ActiveWorkbook.name
    xfilename = filename

    If Right(filename, 4) = ".xls" Then
    xfilename = Left(filename, Len(filename) - 4)
    ElseIf Right(filename, 5) = ".xlsx" Then
    xfilename = Left(filename, Len(filename) - 5)
    ElseIf Right(filename, 5) = ".xlsm" Then
    xfilename = Left(filename, Len(filename) - 5)
    End If

    savedFile = mainFilePath & "\" & title & name & " (" & xfilename & ")" & ".xlsx"

    ' Debug
    MsgBox "Next filename to be saved is: " & title & name & " (" & xfilename & ")" & ".xlsx"

    'Add the workbook
    Workbooks.Add
    ActiveWorkbook.SaveAs (savedFile)

    ' Remember the filename of this work book
    file_copy = ActiveWorkbook.name

    ' Activate the orig file, since after creation of new file, we lost focus
    Workbooks(filename).Activate

    ' Select orig main sheet
    Worksheets(mainWorkSheetName).Select

    ' Copy the data for this specific person
    Range(Cells(r, c), Cells(r1, c1 + 5)).Copy

    ' Change workbook focus and paste to sheet1 of this workbook
    Workbooks(file_copy).Activate
    ActiveSheet.Paste

    ' Save the new file and close
    ActiveWorkbook.Save
    ActiveWorkbook.Close

    limit = limit + 1

    ' Debug
    'MsgBox "The value of r after closing of new workbook is " & r
    'MsgBox "The value of limit is " & limit

    Else
    ' Exit the loop since f is not found

    ' Debug
    'MsgBox "Exiting the do-while loop"

    Exit Do

    End If

    Loop

    ' Debug
    MsgBox "Done!! number of files created: " & limit

    End Sub


    -- edited by ram2010 on Jul 20 2014, 01:14 AM
  • pa OT mga bossing ito kc yung code ko
    pero my lumalabas syang error na .
    "Either BOF or EOF is true, or the current records has been deleted. Requested operation requires a current record" vb6 po gamit kong software.
    ito po yung code
    Set rst = New ADODB.Recordset
    rst.Open "select Name to tbl_Philhealth = '" & txtname.Text & "'", con, adOpenKeyset, adLockOptimistic
    x = 0
    If txtname.Text = Empty Then
    x = x + 1
    End If
    If x = 0 Then

    txtname.Text = rst!Name
    cmbsalbra.Text = rst!Salarybracket
    txtsal.Text = rst!Salary
    txter.Text = rst!ERShare
    txtee.Text = rst!EEShare
    txttot.Text = rst!Total
    rst.Update
    rst.MoveNext


    MsgBox "Record has been succesfully updated!", vbInformation, "Saved!"
    Unload Me
    Unload frmmain
    frmmain.Show
    frmmain.LV.Refresh
    End If

    If x = 1 Then
    MsgBox "Please Fill up all the information needed!", vbInformation, "Incomplete!"
    End If
    ty ^^
  • xxiidark Send Message View User Items on July 21, 2014 02:42 PM

    Try posting it in vb6 sub-forum.
  • @ sir Ram and khedfreck thanks po sa help niyo.

    what if for example. iba ibang klase ng text style siya pero yung gusto ko lang maextract po is yung number. for ex:

    Cell A
    asdasd 1230 sdad
    da 3450 sd
    a 6780 b
    dsd sdsd 9101
    asd sdsd 9888 asd sds

    Cell B (results)
    1230
    3450
    6780
    9101
    9888


    Yong nasa Cell A, pwede mo itong gamitan ng text to column such that mahihiwalay sila per line. Saka mo na e extract ang number doon sa mga individual cells. Once ma extract na ang mga numbers, pwede mo na uli itong e combine sa isang cell.

    Hindi ito madali, pero pwede siyang gawan ng paraan.

    Pag marami ang mga ito, macro na lang siguro.



    Try mo to: http://chandoo.org/wp/2012/06/19/extract-numbers-from-text-excel/

    Medyo madugo yung formula.
  • a big thanks Sir Ram :)

    Ill will try to follow your instruction and let you know.

    looking at the structure of the codes yeah its complicated nga.

    pero i think pwd natin simplihan just by eliminating my first request(regroup to another sheet called "Per Name") using "Group" function in excel or if not manual sorting like in the Per name sheet (previous process)

    again thanks a lot and ill keep you posted :) YGPM
  • khedfreak Send Message View User Items on July 21, 2014 10:48 PM

    [...]

    Try mo to: http://chandoo.org/wp/2012/06/19/extract-numbers-from-text-excel/

    Medyo madugo yung formula.

    Hindi nga madali yan :).

    Dapat e try ito ni Dstar015.
  • pwede po uling magtanung baka po matulungan nyo ko sa ginagawa kong budget sheets at expenses.

    bale meron ako ginawang sheet na me mga expenses at kita at me other sheets na andon na ang lahat ng details about sa expenses.

    pwede kayang sa unang sheet pagme tinype akong amount magaappear sya don sa isang sheet na me details, then don naman sa details pagtinype ko din ng manually magbabago naman don sa unang sheets na the same row din. parang circular reference ata tawag don.

    pano po kaya tong gawin at posible po kaya?

    kasi pagkakaalam ko diba once na me formula ang row at minanual type mo mawawala ang formula. pero baka lang me way na magawa yun
  • einjelhart Send Message View User Items on July 26, 2014 08:01 PM

    bale meron ako ginawang sheet na me mga expenses at kita at me other sheets na andon na ang lahat ng details about sa expenses.

    pwede kayang sa unang sheet pagme tinype akong amount magaappear sya don sa isang sheet na me details, then don naman sa details pagtinype ko din ng manually magbabago naman don sa unang sheets na the same row din. parang circular reference ata tawag don.

    pano po kaya tong gawin at posible po kaya?

    Pwede ito. Try mo itong gawin.
    1. Open microsoft visual basic editor within excel, open excel then press alt+f11
    2. Double click ThisWorkbook
    3. At right window of the editor, select sheet_change in the pull down menu
    What you will see is a function below
    Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

    End Sub

    Now insert the code below in this function, as in
    Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

    numRow = Target.Row
    numCol = Target.Column

    If ActiveSheet.Name = "Sheet1" Then
    Sheets("sheet2").Cells(numRow, numCol).Value = Sh.Cells(numRow, numCol).Value
    ElseIf ActiveSheet.Name = "Sheet2" Then
    Sheets("sheet1").Cells(numRow, numCol).Value = Sh.Cells(numRow, numCol).Value
    End If


    End Sub

    Ang ginawa ng code na ito ay every time na mag type ka sa sheet1 sa cell a1, ng 100, mag appear din ito sa sheet2 ng 100 sa cell a1 and vice versa. Hindi lang sa cell a1, try it. In the formula numRow and numCol ay parehas na ina apply sa sheet1 at sheet2.

    The code is flexible, you can revise it to suit your needs, can be same column, or same row, or same column with different row or same row with different column. The sheets names can also be manipulated.

    -- edited by ram2010 on Jul 27 2014, 11:58 AM
  • @ ram2010

    Thanks boss and im back - YGPM, post to share ko na lang din ung msg ko sa iba :)

    done testing the macro and it works like a charm. My amendments lang sana ako if kaya pa ng powers and knowledge nyo :)

    file located here: https://drive.google.com/folderview?id=0B_Vrkz2MJm5meW1ma3RhUTNhSlk&usp=sharing

    1. Dalawa ung file Pay February 16-28 2014 our main file for data. and another file called Macro. sa macro na to andito ung list ng name na kailangan gawan ng individual excel file - isesearch xa dun sa main data natin under sheet name "Per Name"

    kaya ba un if nasa ibang workbook ung macro file kahit sa same excel lang xa buksan? reason is paiba iba kc ung pay cut off.

    2. Dun sa magiging individual file oki lang ba na iadjust dun sa column B nagsstart - see sample output "Pay confirmation - Julie Smith (February 16-28 2014)"

    3. Remove pop-up windows. see pop up window.docx


    Again, maraming salamat i know busy din kayo kaya basta salamat sa effor and sa oras :)
  • 3. Remove pop-up windows. see pop up window.docx

    You can disable this by appending an apostrophe before the upper case letter M.
    ' Debug
    'MsgBox "Name: " & name & ", Total: " & Cells(r1, c1).Offset(0, 2).Value


    And this.
    ' Debug
    'MsgBox "Next filename to be saved is: " & title & name & " (" & xfilename & ")" & ".xlsx"


    Yong item 1 and 2 later na.

    -- edited by ram2010 on Jul 27 2014, 11:15 PM
  • You have not mentioned how do you validate values entered under columns B, C and D, when a value of 2 is entered under column A, but anyway here is what I did for both situations where the value under column A is either 2 or 3.
    To validate columns B and C when 2 or 3 is entered in column A. In this example, select B2 to C2 then click data validation, then customs then under the formula input the following.
    =OR(AND(COUNTIF($B2:$D2,B2) <= 1,$A2=3),$A2=2)

    To validate values at column D, when 2 or 3 is entered under column A, select D2 then customs then under the formula input the following.
    =AND(COUNTIF($B2:$D2,D2) <=1, $A2=3)

    The formula above included a non-duplicate validation for values entered in column B, C and D when 3 is entered under column A. The countif() <= 1, ensures that duplicates are not allowed.

    You can copy the validation format along the rows depending on how many rows you want to validate, the absolute and relative cell references are considered in $B2:$D2, and $A2.

    I used excel 2007 for this exercise.

    -- edited by ram2010 on Jul 09 2014, 10:20 AM


    Sir ram2010 many many thanks po gumana po. now ko lang po nabasa na may sumagot hehehe. maraming salamat po ulit
  • johnToT Send Message View User Items on July 27, 2014 10:30 PM

    Regarding item 2, please insert the bolded statement below. Before pasting, activate muna yong cell sa B1.

    ' Change workbook focus and paste to sheet1 of this workbook
    Workbooks(file_copy).Activate
    Range("B1").Select
    ActiveSheet.Paste
  • Thanks Sir Ram2010 noted to, active cell nga lang pala hehe salamat :)
  • johnToT Send Message View User Items on July 27, 2014 10:30 PM

    Here is the code for item 1. Make sure that the file called macro.xlsx is in the same directory with the main file.
    Notes:
    0. Macro name is different from older one.
    1. While program is running you will see the progress in the status bar, saying please wait saving ...
    2. After program is completed, number of files saved and elapsed time in seconds is displayed in status bar.
    3. The var maxRow is set at 100 for your first try, you can increase this in the code. I have tried running all names and set this to 1710
    and it works all right producing 88 new files
    4. The total per name is added in the macro.xlsx column C
    5. The status done is written under column D in macro.xlsx also
    6. Most codes are revised, and more comments are added, some var names are changed for readability
    7. Important, the macro.xlsx file is not saved, note that in this file columns C and D are updated. You have to save it if you want the changes.
    8. Before running create_files_v2(), you have to close the file macro.xlsx.
    9. I set Application.DisplayAlerts to false because there seems to be a link in the sheet in the file that you uploaded. So when copy is created to a new file, the link is not updated.
    10. You need to cleanup your sheets, I received excel warning that there is circular reference, this will slow down excel calculation but have not noticed such slow down at the moment.
    11. Added Option Explicit so we don't mess up with the variables


    Option Explicit
    Sub create_files_v2()
    ' This macro will create and save new workbooks based on names
    ' from other file called macro.xlsx

    ' Timing the macro, elapsed time will be displayed in status bar before pressing done
    Dim timeStart As Single
    timeStart = Timer

    Dim mainFilePath As String
    Dim mainWorkSheetName As String
    Dim mainWorkbookName As String
    Dim nameToSearch As String
    Dim nameInMainFile As String
    Dim title As String ' This is for "Pay confirmation"
    Dim name As String ' Name of the person, that is part of the filename
    Dim xfilename As String ' A temp var for main workbook name
    Dim v As String, v1 As String 'v for "KeyDevID", and v1 for "TOTAL"
    Dim savedFile As String ' Filename of the new file
    Dim newFileWorkbookName As String

    Dim r As Integer, c As Integer, r1 As Integer, c1 As Integer
    Dim n As Integer, x As Integer, y As Integer
    Dim maxRow As Integer ' Max rows to scan in the main file, to be configured by the user
    Dim numEmployees As Integer
    Dim savedFileCount As Integer

    Dim isFoundName As Boolean

    r = 0
    maxRow = 100 '1710
    savedFileCount = 0

    ' Location of the main file
    mainFilePath = Application.ActiveWorkbook.Path
    MsgBox "This file is located in: " & mainFilePath & ". New files will also be created in this path."

    ' This shoul be the main file workbook
    mainWorkbookName = ActiveWorkbook.name

    ' This should be the sheet where main data are stored
    mainWorkSheetName = ActiveSheet.name
    'MsgBox "Active sheet name is: " & mainWorkSheetName

    ' Open the macro file, for reading and writing
    Workbooks.Open filename:="macro.xlsx"

    ' Activate the main workbook again we are reading from this sheet
    Workbooks(mainWorkbookName).Activate

    ' Turn off screen updates to speedup the process
    Application.ScreenUpdating = False

    ' Turn off alerts, i.e there could be links in the sheets, in this case those will not be updated
    Application.DisplayAlerts = False

    ' Enable display of messages in status bar
    Application.DisplayStatusBar = True

    ' Get number of employees in macro.xlsx
    numEmployees = Workbooks("macro.xlsx").Sheets("payee").Cells(Rows.Count, "A").End(xlUp).Row
    ' Debug.Print "Total names: " & CInt(numEmployees - 1) ' Subtract 1 because of header

    ' Loop thru the names in column A in macro.xlsx, start at row 2 because of header
    For n = 2 To numEmployees

    ' Get the names from the macro.xlsx
    nameToSearch = Workbooks("macro.xlsx").Sheets("payee").Cells(n, 1).Value

    ' Exit if nameToSearch is empty, this would mean that gaps in column A in macro.xlsx is not recommended
    ' It is better to put "None" for example than just an empty cell.
    If nameToSearch = "" Then
    Exit For
    End If

    ' Debug
    ' MsgBox "name to search is: " & nameToSearch
    ' Debug.Print nameToSearch

    r = 0

    ' Flag if we found a KeyDevID and a total
    isFoundName = False

    ' Debug
    ' MsgBox "The Value of overall incrementer r after the do-while loop is " & r

    'loop thru the rows in column B to find keydevid and total
    For x = r + 1 To maxRow

    v = Cells(x, 2).Value

    If v = "KeyDevID" Then
    r = x
    c = 2

    ' The name to be searched is offset 1 row and offset 1 column from KeyDevID
    nameInMainFile = Cells(r, c).Offset(1, 1).Value

    ' Debug
    ' MsgBox "name with this keydevid is: " & nameInMainFile

    If nameToSearch <> nameInMainFile Then
    GoTo CONTINUE_THE_SEARCH
    End If

    ' Debug
    ' MsgBox "We found a " & Cells(r, c).Value & " at row " & x

    ' Continue to search and find "TOTAL" with offset 27 from column 2
    For y = x + 1 To maxRow
    v1 = Cells(y, 2).Offset(0, 27).Value
    If v1 = "TOTAL" Then
    r1 = y
    c1 = 29

    ' Debug
    ' MsgBox "We found a total of " & Cells(r1, c1).Offset(0, 2).Value

    ' Update the total column or column c in macro.xlsx
    Workbooks("macro.xlsx").Sheets("payee").Cells(n, 3).Value = Cells(r1, c1).Offset(0, 2).Value

    isFoundName = True
    Exit For

    End If

    Next y

    If isFoundName Then
    Exit For
    End If

    End If

    CONTINUE_THE_SEARCH: ' If the name from macro.xlsx is not found we continue to search the next name

    Next x

    ' If we found the name in the main file, we will create a new file copy some data save it and close
    If isFoundName Then

    title = "Pay confirmation - "
    name = ActiveSheet.Cells(r + 1, 3)

    ' Debug
    ' MsgBox "Name: " & name & ", Total: " & Cells(r1, c1).Offset(0, 2).Value

    xfilename = mainWorkbookName

    If Right(mainWorkbookName, 4) = ".xls" Then
    xfilename = Left(mainWorkbookName, Len(mainWorkbookName) - 4)
    ElseIf Right(mainWorkbookName, 5) = ".xlsx" Then
    xfilename = Left(mainWorkbookName, Len(mainWorkbookName) - 5)
    ElseIf Right(mainWorkbookName, 5) = ".xlsm" Then
    xfilename = Left(mainWorkbookName, Len(mainWorkbookName) - 5)
    End If

    savedFile = mainFilePath & "\" & title & name & " (" & xfilename & ")" & ".xlsx"

    ' Debug
    ' MsgBox "Next filename to be saved is: " & title & name & " (" & xfilename & ")" & ".xlsx"

    ' Add the workbook
    Workbooks.Add
    ActiveWorkbook.SaveAs (savedFile)

    ' Remember the filename of this work book
    newFileWorkbookName = ActiveWorkbook.name

    ' Activate the orig file, since after creation of new file, we lost focus
    Workbooks(mainWorkbookName).Activate

    ' Select orig main sheet
    Worksheets(mainWorkSheetName).Select

    ' Copy the data for this specific person
    Range(Cells(r, c), Cells(r1, c1 + 5)).Copy

    ' Change workbook focus and paste to sheet1 of this workbook
    Workbooks(newFileWorkbookName).Activate
    Range("B1").Select ' The pasted data will start in cell B1
    ActiveSheet.Paste

    ' Save the new file and close
    ActiveWorkbook.Save
    ActiveWorkbook.Close

    ' After closing the newly created file, we assume that our active workbook will the main workbook
    ' and our active worksheet is the main worksheet
    ' MsgBox "Active workbook: " & mainWorkbookName & ", Active worksheet: " & mainWorkSheetName

    ' Count number of file saved for summary message
    savedFileCount = savedFileCount + 1

    ' Display progress in the status bar, there is a delay of 1 sec to display this status
    Application.StatusBar = "Please wait ... saving " & newFileWorkbookName
    Application.Wait Now + TimeValue("00:00:01")

    ' Add a status "Done" in column d of the macro.xlsx
    Workbooks("macro.xlsx").Sheets("payee").Cells(n, 4).Value = "Done"

    End If

    Next n

    ' Turn on screen updates
    Application.ScreenUpdating = True

    ' Turn on alerts
    Application.DisplayAlerts = False

    ' Display summary in the status bar
    Application.StatusBar = "Done!! files saved = " & savedFileCount & ", elapsed: " & Round(Timer - timeStart, 2) & " sec"

    ' Debug
    MsgBox "Done!!"

    ' Program will retake status bar
    Application.StatusBar = False

    End Sub


    -- edited by ram2010 on Jul 28 2014, 04:57 PM
  • @ ram2010

    Thanks a lot Sir ram2010

    I will definitely try this, and will let you know if i have question and inputs again thanks for the help :)
  • @ ram2010

    Done testing - working fine as as usual ^_____^ Thanks a lot

    Question to this code:

    ' Save the new file and close
    ActiveWorkbook.Save

    --> can we insert a code that will rename the worksheet from Sheet1 to Payee name? Ex. Sheet1 to Aldei Gregoire

    ActiveWorkbook.Close
  • Rename the sheet before saving.
    ActiveSheet.Paste

    ' Rename sheet1
    ActiveSheet.name = nameToSearch

    ' Save the new file and close
    ActiveWorkbook.Save
    ActiveWorkbook.Close
  • Thanks again ram2010 all working now :)
  • Mga master ask ko lang if paano mag change ng font type size color using VB code in excel. Im creating an email macro and heres my code.

    Any comment / suggestions? TIA

    With OutMail
    .to = cell.Value
    .Subject = cell.Offset(0, 2).Value
    .cc = cell.Offset(0, 1).Value
    .BODY = "Hi " & cell.Offset(0, 5).Value
    .HTMLBody = StrBody

    StrBody = "Hi " & cell.Offset(0, 5).Value & "<br><br>" & _
    Output is Hi Name - Name is based on cell value

    Sheets("Sheet1").Range("L4").Value & "<br><br>" & _
    Sheets("Sheet1").Range("L6").Value & "<br><br>" & _
    Sheets("Sheet1").Range("L8").Value & "<br><br><br>" & _
    Sheets("Sheet1").Range("L11").Value & "<br>" & _
    Sheets("Sheet1").Range("L28").Value & "<br>"

Who's Online

291 active users within the last minute, 152 members, 139 guests.
Our newest member is gerome30
Click here to see online members.

Browse Items

More »

Search TipidPC


New Want to Buys

Active Items for Sale

Active Want to Buys