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

  • Hi mga excel masters!

    Need your help on producing this kind of format.

    <click here for link>

    External Image


    Thanks!

    -- edited by probaldur on Mar 10 2014, 02:14 PM
  • probaldur Send Message View User Items on March 10, 2014 01:54 PM

    Here is a sample solution from macro below.
    Requirements:
    1. Put your data in sheet1
    2. Make sure that there is sheet2, (for storage of temp data).
    3. Provide sheet3, (this is the sheet where data are re-formatted).
    4. Create a module and insert the macro below, there are light comments in the macro.

    My Sample data in sheet1
    col1 col2 col3 col4
    a1 1 1 1
    a1 1 1 1
    a2 2 2 2
    a3 3 3 3
    a3 3 3 3


    After the run.
    sheet2
    a1
    a2
    a3


    Sheet3
    col2 col3 col4
    a1
    1 1 1
    1 1 1
    a2
    2 2 2
    a3
    3 3 3
    3 3 3


    Macro here.
    Sub ReArrangeData()

    '(1) clear sheet2, and sheet 3
    For i = 1 To 1000
    For j = 1 To 5
    Sheets("sheet2").Cells(i, j).Value = ""
    Sheets("sheet3").Cells(i, j).Value = ""
    Next j
    Next i

    '(2) store the major unique items in col1 from sheet1 into sheet2 temporarily
    For i = 2 To 500
    Value1 = Sheets("sheet1").Cells(i, 1).Value
    'exit for if this cell is empty
    If Value1 = "" Then
    Exit For
    End If

    'scan sheet2
    For j = 1 To 500
    Value2 = Sheets("sheet2").Cells(j, 1).Value
    'exit for if cell is empty and record value1
    If Value2 = "" Then
    Sheets("sheet2").Cells(j, 1).Value = Value1
    Exit For
    End If

    'exit for if value1 is already stored
    If Value1 = Value2 Then
    Exit For
    End If
    Next j
    Next i
    ' unique items are now in sheet2

    '(3)use sheet3 to write the unique items in sheet2 as main header
    'scan sheet2
    found = False
    For i = 1 To 1000

    Value2 = Sheets("sheet2").Cells(i, 1).Value
    If Value2 = "" Then
    Exit For
    End If

    'find value2 in sheet1 and store its members in sheet3
    'scan sheet3
    For j = 2 To 1000 'j=1 is for header

    value3 = Sheets("sheet3").Cells(j, 1).Value
    If value3 = "" Then
    Sheets("sheet3").Cells(j, 1).Value = Value2
    'scan sheet1 and find the members of current unique value2
    cnt = 0
    For k = 2 To 1000
    If Sheets("sheet1").Cells(k, 1).Value = Value2 Then
    cnt = cnt + 1 'provide space vertically
    'store it
    Sheets("sheet3").Cells(j + cnt, 1).Value = Sheets("sheet1").Cells(k, 2).Value 'save col2 of sheet1
    Sheets("sheet3").Cells(j + cnt, 2).Value = Sheets("sheet1").Cells(k, 3).Value
    Sheets("sheet3").Cells(j + cnt, 3).Value = Sheets("sheet1").Cells(k, 4).Value
    found = True
    End If
    Next k

    'exit curent for, if we found the unique item, so we can scan again the next unique item
    If found = True Then
    Exit For
    End If

    End If

    Next j

    Next i

    '(4) write header of sheet3 based on sheet1 header
    For i = 1 To 3
    Sheets("sheet3").Cells(1, i).Value = Sheets("sheet1").Cells(1, i + 1).Value
    Next i

    '(5)
    MsgBox "done"

    End Sub
  • will try this sir! thanks for the help.
  • @sir Ram

    did some modifications sa script.

    on step 1 clearing

    '(1) clear sheet2, and sheet 3
    For i = 1 To 1000
    For j = 1 To 5
    Sheets("sheet2").Cells(i, j).Value = ""
    Sheets("sheet3").Cells(i, j).Value = ""
    Next j
    Next i


    to

    Sheets("Sheet2").Select
    Cells.Select
    Selection.Delete Shift:=xlUp

    Sheets("Sheet3").Select
    Cells.Select
    Selection.Delete Shift:=xlUp


    may mga naiiwan kasi na formatted cells kung i replace lang with blanks un cells. :)
    nageenjoy na ko sa macro ng excel haha
  • probaldur Send Message View User Items on March 12, 2014 09:09 AM

    did some modifications sa script.

    No problem at all, I actually get interested when the user do some modifications to the code.
    Also note doon sa mga for loop, check the maximum limit of looping, i.e,
    for i=2 to 1000.
  • yep. thanks sir! :)
  • you can use the macro-record of the excel then fine-tune it.
    click first the record macro button, then from your original region/sheet rearrange those on your desired format. then, click stop record.
    from there, you can have the script right away then do some cleaning and fine-tuning.
  • btw, here's my version of your request:

    Sub format_to_new_format()
    Dim a, b, c, d, datanum As Integer
    Dim ref1, ref2 As String

    'sort
    Columns("A:D").Select
    Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal
    ActiveSheet.Cells(2, 1).Select

    'delete redundancy in col1
    ref1 = ActiveSheet.Cells(2, 1)
    For a = 3 To 65000
    If ActiveSheet.Cells(a, 1) = "" Then
    b = a
    GoTo ex1
    End If
    If ActiveSheet.Cells(a, 1) = ref1 Then
    ActiveSheet.Cells(a, 1) = ""
    End If
    If ActiveSheet.Cells(a, 1) <> ref1 Then
    ref1 = ActiveSheet.Cells(a, 1)
    End If
    Next a
    ex1:

    'spacing

    Rows("2:2").Select
    Selection.Insert Shift:=xlDown
    For a = 4 To b
    If ActiveSheet.Cells(a, 1) <> "" Then
    Range(Cells(a, 1), Cells(a, 4)).Select
    Selection.Insert Shift:=xlDown
    a = a + 1
    End If
    Next a
    'transfering data
    For a = 2 To b
    If ActiveSheet.Cells(a, 2) = "" Then
    ActiveSheet.Cells(a, 2) = ActiveSheet.Cells(a + 1, 1)
    ActiveSheet.Cells(a + 1, 1) = ""
    End If
    Next a


    End Sub
  • Sir ram, good day!

    about the tracking for the tv that you made. can i add another column on that sheet? like i want to add "Issued by" so that i can track who's the one who issued the TV's on the room. also what is the purpose of costumer ID and supplier sheet. you mean i can add the supplier where we bought the TV's how about the Costumer ID?

    another question, if i'm using 18 inches TV's is there any way that i can track or see what size of the TV'S the we issued or i need to add another column for the on the LOG sheets.
    please advise.

    thanks,
  • einjelhart Send Message View User Items on March 30, 2014 01:26 PM


    about the tracking for the tv that you made. can i add another column on that sheet? like i want to add "Issued by" so that i can track who's the one who issued the TV's on the room.

    You can add, I recomment to add it after column "Brand" in log sheet.

    also what is the purpose of costumer ID and supplier sheet. you mean i can add the supplier where we bought the TV's how about the Costumer ID?

    Purpose of customer ID is just to identify unique number for every customers. Tracking of customers is easy if you include it in the log sheet. You may develop in the future how to enhance customer services, so they will not go to your competitors. It is of course possible to extract customers from log sheet (provided you update the customers there) and put it in customer id sheet by using a macro.

    Same with supplier, bad history of supplied items connected to your supplier can be tracked and would be good for you if ever you will look for alternative suppliers.
    Or even good for the supplier if you inform to them what are the weaknesses of their supplied items.

    another question, if i'm using 18 inches TV's is there any way that i can track or see what size of the TV'S the we issued or i need to add another column for the on the LOG sheets.

    Just add another column for size, should be after Brand column in log sheet. Note you can add it once only, at a time that you first entered the item in log sheet. A macro can be revised so that this info together with other product info in log sheet can be added into the product sheet.
  • mga sirs, I think kung simpleng data transfer lang from one(1) sheet to another and if and tanong ni sir kung anong easiest way to do data transfer I recomend use simple "vlookup" or "hlookup" nalang.. di ko po know kung may mas simpleng way kaysa dito
  • thank you sir ram try ko tong gawin bukas, now lng ulit ako nakadalaw ulit, me reply ka na pla.. :)
  • Sirs, patulong. I have 100 files saved in a folder. Each file has 2 sheets, yung 2nd sheet may formula. Gusto ko sana baguhin yung formula dun sa sheet na yun for the 100 files or copy a sheet from another workbook (with the formula) then overwrite yung 2nd sheet. Possible po ba? Thanks!
  • migsvill Send Message View User Items on April 16, 2014 02:49 PM

    Here is a sample vba code.
    What this code does is open every excel file in a given directory and copy the sheet2 of main.xlsm (your main excel file that will
    contain this macro). Again sheet2 of this file will replace sheet2 of 100 files in your folder.
    The code below will open one of 100 files one by one and will delete sheet2, excel will prompt you if you really delete the sheet2, then activate the main excel file then copy the sheet2 of this file to one of the 100 files just opened. After copying the sheet2, this file will be closed. Then another file will be opened.

    Procedure:
    1. Create main.xlsm
    2. Make sheet2 of this file as the one that will replace the sheet2 of the 100 excel files
    3. Copy the 2 macro below into the module of main.xlsm
    Sub OpenExcelFiles()

    Dim numberOfFiles
    Dim file_name As String
    Dim Folder As String
    Dim File As String
    Folder = "c:\tpc\project 1"
    File = Dir(Folder & "\*.xlsx")

    'Counter how many files are opened and processed
    numberOfFiles = 0

    Do While File <> ""
    file_name = Folder & "\" & File
    Workbooks.Open Filename:=file_name

    'Debug
    MsgBox "name of file to be revised is " & File

    'Replace sheet2 of the file just opened
    Call ReplaceSheetOf(File)

    numberOfFiles = numberOfFiles + 1

    'Save the file before closing
    ActiveWorkbook.Close SaveChanges:=True

    'Next file
    File = Dir
    Loop

    MsgBox "done, there are " & numberOfFiles & " files processed!!"

    End Sub

    Sub ReplaceSheetOf(fileNameTo As String)

    Windows(fileNameTo).Activate

    'Delete sheet2 of this file
    Sheets("Sheet2").Select
    ActiveWindow.SelectedSheets.Delete

    'Activate the main file and copy its sheet2 to filenameTo
    Windows("main.xlsm").Activate
    Sheets("Sheet2").Select
    Sheets("Sheet2").Copy Before:=Workbooks(fileNameTo).Sheets(2)

    'Debug
    MsgBox "sheet2 of main.xlsm was copied to " & fileNameTo

    End Sub


    4. In the example macro above, You should put your 100 files in directory c:\tpc\project 1,
    I repeat, project 1 is a sub-directory of the tpc directory under c drive,
    or revise the macro depending on the current directory of your 100 files.

    Notes:
    1. Before running the macro with your real files, it is better to run some sample files say 5 files first
    to familiarize with this macro.
    2. I provide some msgbox along the code so, it is better to comment this out if you will be running your real 100 files,
    as otherwise you will be pressing these boxes num_file times.
    3. Always make a backup of your original files.
    4. There are comment in the code, have a look on it.
    5. Do not put other excel files in the directory, because it will be opened get processed. Only those 100 files will be in that directory.
    6. If you run a sample run just put 5 files in that directory.
    7. A msgbox will display how many files are processed after the run.
    8. I have tried this code for 3 files and it worked.
    9. Do not include your main.xlsm in the the directory of your 100 files. Save it somewhere.

    -- edited by ram2010 on Apr 16 2014, 10:41 PM
  • Revision 1.
    Turn off display alerts when you are deleting sheet2.
    Revisions are bolded. Just use this sub when you are running the real 100 files.

    Sub ReplaceSheetOf(fileNameTo As String)

    Windows(fileNameTo).Activate

    'Turn off display alerts
    Application.DisplayAlerts = False


    'Delete sheet2 of this file
    Sheets("Sheet2").Select
    ActiveWindow.SelectedSheets.Delete

    'Activate the main file and copy its sheet2 to filenameTo
    Windows("main.xlsm").Activate
    Sheets("Sheet2").Select
    Sheets("Sheet2").Copy Before:=Workbooks(fileNameTo).Sheets(2)

    'Debug
    MsgBox "sheet2 of main.xlsm was copied to " & fileNameTo

    'Turn on display alets
    Application.DisplayAlerts = True


    End Sub
  • sir ram, musta? about don sa tracking naglagay ako ng column for size ng tv pero di sya nagappear sa ibang sheet like yung report at sa broken sheet. dapat bang imanual ko lng ang paglagay non sa ibang sheet? paadvise lang sir. thank you
  • einjelhart on April 19, 2014 12:14 AM

    Dapat e revise ang macro to suit your needs.
    It is very important na e finalize mo na ang info sa mga sheets mo.
  • ok sir i will prepare everything then i will upload it here. thanks

Who's Online

1036 active users within the last minute, 594 members, 442 guests.
Our newest member is meubhin2011
Click here to see online members.

Browse Items

More »

Search TipidPC


New Want to Buys

Active Items for Sale

Active Want to Buys