I need to arrange numbers in another sequence

have this sequence in sheet DTA

need be change to  sequence  in sheet AP
123.xlsx
ADRIANA PACCOUNTING ASSISTANTAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

David Johnson, CD, MVPOwnerCommented:
we have the sheet , but aren't mind readers to know from what format to what format
0
ADRIANA PACCOUNTING ASSISTANTAuthor Commented:
Thanks David Johnson for the fast response

i really don't need change the format but the presentation
 from  an list down to the way is show in the "AP" sheet

AM=A

PM = P
0
Martin LissOlder than dirtCommented:
It looks like you should have posted an xlsm version of your workbook because xlsx workbooks don't contain code, and I assume there is code in your original workbook that generates the data on the DTA sheet..
0
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

Martin LissOlder than dirtCommented:
In that code look for hardcoded values of "AM" and "PM" and change them to "A" and "P".
1
ADRIANA PACCOUNTING ASSISTANTAuthor Commented:
Thanks Martin  for you fast response

i need take the data from dta  sheet    and  show it in AP sheet

1- by the week number
2- then by the day
3- then by the AM or PM
0
ADRIANA PACCOUNTING ASSISTANTAuthor Commented:
Martin Liss  rigth now is not any code  but is a great list

in this sample i have just a few data to show  what i try to get
0
ADRIANA PACCOUNTING ASSISTANTAuthor Commented:
Sorry !
i have to add i have to be show  in horizontal  like the AP sheet

can't be vertical  list like the origin in DTA sheet
0
Ryan ChongCommented:
if you want to try a vba solution, you could try:

Sub test()
    Dim Sheet_dta As Worksheet, Sheet_Ap As Worksheet
    Dim D As String, Code As String, AmPm As String
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    Set Sheet_dta = Sheets("DTA")
    Set Sheet_Ap = Sheets("AP")
    
    startRow_t = 2
    'Get last rows
    lastRow_s = Sheet_dta.Cells(Sheet_dta.Rows.Count, "B").End(xlUp).Row
    lastRow_t = Sheet_Ap.Cells(Sheet_Ap.Rows.Count, "C").End(xlUp).Row + 2
    
    'Delete previous rows
    Sheet_Ap.Rows(startRow_t & ":" & lastRow_t).Delete
    
    With Sheet_dta
        For i = 1 To lastRow_s
            D = .Cells(i, "B")
            Code = .Cells(i, "L")
            AmPm = .Cells(i, "M")
            
            'Header
            If D <> "" And Code = "" And AmPm = "" Then
                startRow_t = startRow_t + 2
                
                Sheet_Ap.Cells(startRow_t, "C") = D
                Sheet_Ap.Cells(startRow_t, "E") = "MON"
                MergeCells Range(Sheet_Ap.Cells(startRow_t, "E"), Sheet_Ap.Cells(startRow_t, "F"))
                Sheet_Ap.Cells(startRow_t, "H") = "TUE"
                MergeCells Range(Sheet_Ap.Cells(startRow_t, "H"), Sheet_Ap.Cells(startRow_t, "I"))
                Sheet_Ap.Cells(startRow_t, "K") = "WED"
                MergeCells Range(Sheet_Ap.Cells(startRow_t, "K"), Sheet_Ap.Cells(startRow_t, "L"))
                Sheet_Ap.Cells(startRow_t, "N") = "THU"
                MergeCells Range(Sheet_Ap.Cells(startRow_t, "N"), Sheet_Ap.Cells(startRow_t, "O"))
                Sheet_Ap.Cells(startRow_t, "Q") = "FRI"
                MergeCells Range(Sheet_Ap.Cells(startRow_t, "Q"), Sheet_Ap.Cells(startRow_t, "R"))
                Sheet_Ap.Cells(startRow_t, "T") = "SAT"
                MergeCells Range(Sheet_Ap.Cells(startRow_t, "T"), Sheet_Ap.Cells(startRow_t, "U"))
                
                startRow_t = startRow_t + 1
                Sheet_Ap.Cells(startRow_t, "E") = "A"
                Sheet_Ap.Cells(startRow_t, "F") = "P"
                
                Sheet_Ap.Cells(startRow_t, "H") = "A"
                Sheet_Ap.Cells(startRow_t, "I") = "P"
                
                Sheet_Ap.Cells(startRow_t, "K") = "A"
                Sheet_Ap.Cells(startRow_t, "L") = "P"
                
                Sheet_Ap.Cells(startRow_t, "N") = "A"
                Sheet_Ap.Cells(startRow_t, "O") = "P"
                
                Sheet_Ap.Cells(startRow_t, "Q") = "A"
                Sheet_Ap.Cells(startRow_t, "R") = "P"
                
                Sheet_Ap.Cells(startRow_t, "T") = "A"
                Sheet_Ap.Cells(startRow_t, "U") = "P"
                
                startRow_t = startRow_t + 1
            ElseIf D <> "" And AmPm <> "" Then
                'Debug.Print startRow_t & ": " & D & " : " & Code & " : " & AmPm
                Select Case Weekday(DateValue(D), vbMonday)
                Case 1:
                    If UCase(AmPm) = "AM" Then
                        Sheet_Ap.Cells(startRow_t, "E") = Code
                    ElseIf UCase(AmPm) = "PM" Then
                        Sheet_Ap.Cells(startRow_t, "F") = Code
                    End If
                Case 2:
                    If UCase(AmPm) = "AM" Then
                        Sheet_Ap.Cells(startRow_t, "H") = Code
                    ElseIf UCase(AmPm) = "PM" Then
                        Sheet_Ap.Cells(startRow_t, "I") = Code
                    End If
                Case 3:
                    If UCase(AmPm) = "AM" Then
                        Sheet_Ap.Cells(startRow_t, "K") = Code
                    ElseIf UCase(AmPm) = "PM" Then
                        Sheet_Ap.Cells(startRow_t, "L") = Code
                    End If
                Case 4:
                    If UCase(AmPm) = "AM" Then
                        Sheet_Ap.Cells(startRow_t, "N") = Code
                    ElseIf UCase(AmPm) = "PM" Then
                        Sheet_Ap.Cells(startRow_t, "O") = Code
                    End If
                Case 5:
                    If UCase(AmPm) = "AM" Then
                        Sheet_Ap.Cells(startRow_t, "Q") = Code
                    ElseIf UCase(AmPm) = "PM" Then
                        Sheet_Ap.Cells(startRow_t, "R") = Code
                    End If
                Case 6:
                    If UCase(AmPm) = "AM" Then
                        Sheet_Ap.Cells(startRow_t, "T") = Code
                    ElseIf UCase(AmPm) = "PM" Then
                        Sheet_Ap.Cells(startRow_t, "U") = Code
                    End If
                End Select
                
            End If
        Next
    End With
    
    With Sheet_Ap.Range("E:U")
        .HorizontalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

Sub MergeCells(RgToMerge As Range)
    With RgToMerge
        .Merge
        .HorizontalAlignment = xlCenterAcrossSelection
        .VerticalAlignment = xlCenter
    End With
End Sub

Open in new window

1
ADRIANA PACCOUNTING ASSISTANTAuthor Commented:
Ryan Chong thanks  for you hard work

im not an computer expert !! sorry
can you provide an example  Please!!
0
Ryan ChongCommented:
check this out
123_b.xlsm
1
ADRIANA PACCOUNTING ASSISTANTAuthor Commented:
Ryan Chong Great Job !!

but need to improve it

i mean 1- How i run that?

more data will be put in

2- too many letters
can be adjust like this
adjust
0
Ryan ChongCommented:
some adjustment and you could try customize this:

Sub test()
    Dim Sheet_dta As Worksheet, Sheet_Ap As Worksheet, ws As Worksheet
    Dim D As String, Code As String, AmPm As String
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    Set Sheet_dta = Sheets("DTA")
    Set Sheet_Ap = Sheets("AP")
    
    startRow_t = 4
    'Get last rows
    lastRow_s = Sheet_dta.Cells(Sheet_dta.Rows.Count, "B").End(xlUp).Row
    lastRow_t = Sheet_Ap.Cells(Sheet_Ap.Rows.Count, "C").End(xlUp).Row + 2
    
    'Delete previous rows
    Sheet_Ap.Rows(startRow_t & ":" & lastRow_t).Delete
    
    With Sheet_dta
        For i = 1 To lastRow_s
            D = .Cells(i, "B")
            Code = .Cells(i, "L")
            AmPm = .Cells(i, "M")
            
            'Header
            If D <> "" And Code = "" And AmPm = "" Then
                Sheet_Ap.Cells(startRow_t, "C") = D
                If i > 1 Then startRow_t = startRow_t + 1
            ElseIf D <> "" And AmPm <> "" Then
                'Debug.Print startRow_t & ": " & D & " : " & Code & " : " & AmPm
                Select Case Weekday(DateValue(D), vbMonday)
                Case 1:
                    If UCase(AmPm) = "AM" Then
                        Sheet_Ap.Cells(startRow_t, "E") = Code
                    ElseIf UCase(AmPm) = "PM" Then
                        Sheet_Ap.Cells(startRow_t, "F") = Code
                    End If
                Case 2:
                    If UCase(AmPm) = "AM" Then
                        Sheet_Ap.Cells(startRow_t, "H") = Code
                    ElseIf UCase(AmPm) = "PM" Then
                        Sheet_Ap.Cells(startRow_t, "I") = Code
                    End If
                Case 3:
                    If UCase(AmPm) = "AM" Then
                        Sheet_Ap.Cells(startRow_t, "K") = Code
                    ElseIf UCase(AmPm) = "PM" Then
                        Sheet_Ap.Cells(startRow_t, "L") = Code
                    End If
                Case 4:
                    If UCase(AmPm) = "AM" Then
                        Sheet_Ap.Cells(startRow_t, "N") = Code
                    ElseIf UCase(AmPm) = "PM" Then
                        Sheet_Ap.Cells(startRow_t, "O") = Code
                    End If
                Case 5:
                    If UCase(AmPm) = "AM" Then
                        Sheet_Ap.Cells(startRow_t, "Q") = Code
                    ElseIf UCase(AmPm) = "PM" Then
                        Sheet_Ap.Cells(startRow_t, "R") = Code
                    End If
                Case 6:
                    If UCase(AmPm) = "AM" Then
                        Sheet_Ap.Cells(startRow_t, "T") = Code
                    ElseIf UCase(AmPm) = "PM" Then
                        Sheet_Ap.Cells(startRow_t, "U") = Code
                    End If
                End Select
                
            End If
        Next
    End With
    
    With Sheet_Ap.Range("E:U")
        .HorizontalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

Open in new window

123_c.xlsm
0
ADRIANA PACCOUNTING ASSISTANTAuthor Commented:
Ryan Chong  its looks like what i need !! great job is like what i n eed  to

but some issues    are

for examples

week 28 don't match   but
0
ADRIANA PACCOUNTING ASSISTANTAuthor Commented:
a111111.jpga111222.PNG
0
Ryan ChongCommented:
sorry, think data was being shifted to wrong row... will post an amended one soon.
1
Ryan ChongCommented:
try change:

Sheet_Ap.Cells(startRow_t, "C") = D
If i > 1 Then startRow_t = startRow_t + 1

Open in new window

               
to:

If i > 1 Then startRow_t = startRow_t + 1
                Sheet_Ap.Cells(startRow_t, "C") = D

Open in new window


and it should worked now?
1
ADRIANA PACCOUNTING ASSISTANTAuthor Commented:
Ryan Chong Great Job Expert !!

Correction is  working as needed

other situation  I have is with the cero
i mean   for example27W2013      it say 56     but should be  056
0
ADRIANA PACCOUNTING ASSISTANTAuthor Commented:
a1232134.PNG
0
Ryan ChongCommented:
I guess you mean "065" instead of "056"?

as what was output is based on the source.

anyway, you may try:

Sub test()
    Dim Sheet_dta As Worksheet, Sheet_Ap As Worksheet, ws As Worksheet
    Dim D As String, Code As String, AmPm As String
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    Set Sheet_dta = Sheets("DTA")
    Set Sheet_Ap = Sheets("AP")
    
    startRow_t = 4
    'Get last rows
    lastRow_s = Sheet_dta.Cells(Sheet_dta.Rows.Count, "B").End(xlUp).Row
    lastRow_t = Sheet_Ap.Cells(Sheet_Ap.Rows.Count, "C").End(xlUp).Row + 2
    
    'Delete previous rows
    Sheet_Ap.Rows(startRow_t & ":" & lastRow_t).Delete
    
    With Sheet_Ap.Range("E:U")
        .HorizontalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .NumberFormat = "@"
    End With
    
    With Sheet_dta
        For i = 1 To lastRow_s
            D = .Cells(i, "B")
            Code = .Cells(i, "L")
            AmPm = .Cells(i, "M")
            
            'Header
            If D <> "" And Code = "" And AmPm = "" Then
                If i > 1 Then startRow_t = startRow_t + 1
                Sheet_Ap.Cells(startRow_t, "C") = D
            ElseIf D <> "" And AmPm <> "" Then
                'Debug.Print startRow_t & ": " & D & " : " & Code & " : " & AmPm
                Select Case Weekday(DateValue(D), vbMonday)
                Case 1:
                    If UCase(AmPm) = "AM" Then
                        Sheet_Ap.Cells(startRow_t, "E") = Code
                    ElseIf UCase(AmPm) = "PM" Then
                        Sheet_Ap.Cells(startRow_t, "F") = Code
                    End If
                Case 2:
                    If UCase(AmPm) = "AM" Then
                        Sheet_Ap.Cells(startRow_t, "H") = Code
                    ElseIf UCase(AmPm) = "PM" Then
                        Sheet_Ap.Cells(startRow_t, "I") = Code
                    End If
                Case 3:
                    If UCase(AmPm) = "AM" Then
                        Sheet_Ap.Cells(startRow_t, "K") = Code
                    ElseIf UCase(AmPm) = "PM" Then
                        Sheet_Ap.Cells(startRow_t, "L") = Code
                    End If
                Case 4:
                    If UCase(AmPm) = "AM" Then
                        Sheet_Ap.Cells(startRow_t, "N") = Code
                    ElseIf UCase(AmPm) = "PM" Then
                        Sheet_Ap.Cells(startRow_t, "O") = Code
                    End If
                Case 5:
                    If UCase(AmPm) = "AM" Then
                        Sheet_Ap.Cells(startRow_t, "Q") = Code
                    ElseIf UCase(AmPm) = "PM" Then
                        Sheet_Ap.Cells(startRow_t, "R") = Code
                    End If
                Case 6:
                    If UCase(AmPm) = "AM" Then
                        Sheet_Ap.Cells(startRow_t, "T") = Code
                    ElseIf UCase(AmPm) = "PM" Then
                        Sheet_Ap.Cells(startRow_t, "U") = Code
                    End If
                End Select
                
            End If
        Next
    End With
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

Open in new window

0
ADRIANA PACCOUNTING ASSISTANTAuthor Commented:
Ryan Chong  
a123213412345667890.PNG
0
ADRIANA PACCOUNTING ASSISTANTAuthor Commented:
Ryan Chong  

don't know how set the code

how should be ?
0
Ryan ChongCommented:
have you checked the codes i posted in ID: 42399002?

in general, you got to set the cell's format from General to Text, so that "065" can be displayed as "065" but not 65, similar for other values with value less than 100.

i have shifted the code of formatting before the loop, so that formatting can be done before the values are inserting.

attached is what i'm working with.
123_e.xlsm
1
ADRIANA PACCOUNTING ASSISTANTAuthor Commented:
Ryan Chon  this is working  great !!

then i try to add a big list of data and i get this
b111.PNG
0
ADRIANA PACCOUNTING ASSISTANTAuthor Commented:
b222.PNG
0
Ryan ChongCommented:
yea, that means we need a better error handling and based on that error, it seems that you got "invalid date" for column "B" in sheet: "DTA".

when you mouseover to that highlighted line in Visual Basic Editor, are you able to tell what's the value of D there?
0
Ryan ChongCommented:
in addition, isDate function can be applied into the scripts to verify if the value is a date but to know the root cause, we should debug from the source data itself, assuming data ( column "B" in sheet: "DTA") are valid and all values should be as dates.
0
ADRIANA PACCOUNTING ASSISTANTAuthor Commented:
THIS IS SOME OF THE DATA  SAMPLE NEEDED
0
ADRIANA PACCOUNTING ASSISTANTAuthor Commented:
here
C456.xlsx
0
Ryan ChongCommented:
what about this?

Sub test()
    Dim Sheet_dta As Worksheet, Sheet_Ap As Worksheet, ws As Worksheet
    Dim D As String, Code As String, AmPm As String
    Dim isIgnore As Boolean
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    Set Sheet_dta = Sheets("DTA")
    Set Sheet_Ap = Sheets("AP")
    
    startRow_t = 4
    'Get last rows
    lastRow_s = Sheet_dta.Cells(Sheet_dta.Rows.Count, "B").End(xlUp).Row
    lastRow_t = Sheet_Ap.Cells(Sheet_Ap.Rows.Count, "C").End(xlUp).Row + 2
    
    'Delete previous rows
    Sheet_Ap.Rows(startRow_t & ":" & lastRow_t).Delete
    
    With Sheet_Ap.Range("E:U")
        .HorizontalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .NumberFormat = "@"
    End With
    
    With Sheet_dta
        For i = 1 To lastRow_s
            D = .Cells(i, "B")
            Code = .Cells(i, "L")
            AmPm = .Cells(i, "M")
            
            'Header
            If isHeader(D, Code, AmPm) Then
                If isIgnore = False Then
                    If i > 1 Then startRow_t = startRow_t + 1
                    Sheet_Ap.Cells(startRow_t, "C") = D
                    isIgnore = True
                End If
            ElseIf D <> "" And AmPm <> "" Then
                'Debug.Print startRow_t & ": " & D & " : " & Code & " : " & AmPm
                
                If IsDate(D) Then
                    Select Case Weekday(DateValue(D), vbMonday)
                    Case 1:
                        If UCase(AmPm) = "AM" Then
                            Sheet_Ap.Cells(startRow_t, "E") = Code
                        ElseIf UCase(AmPm) = "PM" Then
                            Sheet_Ap.Cells(startRow_t, "F") = Code
                        End If
                    Case 2:
                        If UCase(AmPm) = "AM" Then
                            Sheet_Ap.Cells(startRow_t, "H") = Code
                        ElseIf UCase(AmPm) = "PM" Then
                            Sheet_Ap.Cells(startRow_t, "I") = Code
                        End If
                    Case 3:
                        If UCase(AmPm) = "AM" Then
                            Sheet_Ap.Cells(startRow_t, "K") = Code
                        ElseIf UCase(AmPm) = "PM" Then
                            Sheet_Ap.Cells(startRow_t, "L") = Code
                        End If
                    Case 4:
                        If UCase(AmPm) = "AM" Then
                            Sheet_Ap.Cells(startRow_t, "N") = Code
                        ElseIf UCase(AmPm) = "PM" Then
                            Sheet_Ap.Cells(startRow_t, "O") = Code
                        End If
                    Case 5:
                        If UCase(AmPm) = "AM" Then
                            Sheet_Ap.Cells(startRow_t, "Q") = Code
                        ElseIf UCase(AmPm) = "PM" Then
                            Sheet_Ap.Cells(startRow_t, "R") = Code
                        End If
                    Case 6:
                        If UCase(AmPm) = "AM" Then
                            Sheet_Ap.Cells(startRow_t, "T") = Code
                        ElseIf UCase(AmPm) = "PM" Then
                            Sheet_Ap.Cells(startRow_t, "U") = Code
                        End If
                    End Select
                    isIgnore = False
                End If
            End If
        Next
    End With
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

Function isHeader(D As String, Code As String, AmPm As String) As Boolean
    If D <> "" And Code = "" And AmPm = "" Then
        If Len(D) = 6 And IsNumeric(Left(D, 1)) And UCase(Mid(D, 2, 1)) = "W" And IsNumeric(Right(D, 4)) Then
            isHeader = True
        ElseIf Len(D) = 7 And IsNumeric(Left(D, 2)) And UCase(Mid(D, 3, 1)) = "W" And IsNumeric(Right(D, 4)) Then
            isHeader = True
        End If
    End If
End Function

Open in new window


it's advised to keep your source data as "clean" as possible else you may need to apply more rules for validations
123_f.xlsm
1

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
ADRIANA PACCOUNTING ASSISTANTAuthor Commented:
Ryan Chong  Great Job!
0
ADRIANA PACCOUNTING ASSISTANTAuthor Commented:
working as needed
i would like to ask for one more adjustment
(before closed it ) let me know if  have to be in new question  please

i need keep the color of format as the input is (DTA sheet colors in cell)
0
ADRIANA PACCOUNTING ASSISTANTAuthor Commented:
aaa1111.PNG
0
ADRIANA PACCOUNTING ASSISTANTAuthor Commented:
Great JOB Expert !
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Office

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.