Ayuda con un macro en excel 97-2003

[pjose07]

Buenas señores foristas, soy nuevo en el foro, he decidido registrarme en esta web porque me ha ayudado en gran parte para este macro.

La cuestion es que no me funciona al 100%.

Es un macro que capta datos para un árbol de categorias, y me falla en 2 puntos:

1. En la columna F2 no me marca el numero de divisiones, coloca un "0"

2. Y cuando termina de captar los datos, vuelve a preguntar la cantidad de subcategorias.

Les invito a que se animen a ver el macro y así, puedan ayudarme.

Se que estoy utilizando repetidamente unas lineas para chequear si hay una celda vacía en una columna para escribir en ella el dato, pero es lo único que me resulto.

De ante mano les extiendo mi agradecimiento.

Sin mas que decir saludos!!!

Veré como les adjunto el archivo.

[pjose07]

ya veo que no puedo adjuntar el archivo, si alguien esta interesado, dejo mi correo y se lo envió, saludos

[email protected]

[pjose07]

Sub cmv13()

UserForm1.Show

Dim Category As String
Dim NCategory As Integer
Dim subcategory As String
Dim NSCategory As Integer
Dim Division As String
Dim NDivision As Integer
Dim SubDivision As String
Dim NSDivision As Integer
Dim count As Integer
Dim count1 As Integer
Dim count2 As Integer
Dim count3 As Integer

Worksheets("Sheet1").Activate

Range("A2:H50").ClearContents

ActiveSheet.Range("A2").Activate

Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Activate
Loop

With ActiveCell
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Activate
Loop
End With

NCategory = InputBox("How many categories are there? : ", "NCategory")

count = NCategory

ActiveSheet.Range("B2").Activate

With ActiveCell
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Activate
Loop
.Value = NCategory
End With

Etiqueta_1:

If count = 0 Then

ThisWorkbook.Save

'Application.Quit

'terminar esta parte del macro(recuerda que falta la parte de asignar los codigos de 3 digitos) y salvar el libro automaticamente

End If

ActiveSheet.Range("A2").Activate

Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Activate
Loop

With ActiveCell
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Activate
Loop
End With

Do While count > 0

ActiveSheet.Range("A2").Activate

Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Activate
Loop

With ActiveCell
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Activate
Loop
End With

Category = InputBox("Enter the name of the category: ", "Category")

TSCategory = MsgBox("Has this category Sub-categories?", vbYesNo + vbQuestion, "Sub-Category")

With ActiveCell
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Activate
Loop
.Value = Category
End With

count = count - 1

If TSCategory = vbYes Then
GoTo subcategoryprocess
Else
GoTo Etiqueta_1
End If

Loop

subcategoryprocess:

ActiveSheet.Range("C2").Activate

With ActiveCell
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Activate
Loop
End With

NSCategory = InputBox("How many Sub-categories are there? : ", "Number of Sub-Category")

count1 = NSCategory

ActiveSheet.Range("D2").Activate

Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Activate
Loop

With ActiveCell
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Activate
Loop
.Value = NSCategory
End With

Etiqueta_2:

If count1 = 0 Then
GoTo Etiqueta_1
End If

ActiveSheet.Range("C2").Activate

With ActiveCell
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Activate
Loop
End With

Do While count1 > 0

ActiveSheet.Range("C2").Activate

With ActiveCell
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Activate
Loop
End With

subcategory = InputBox("Enter the name of the Sub-category : ", "subcategory")

TDivisions = MsgBox("Has this Sub-category Divisions?", vbYesNo + vbQuestion, "Divisions")

With ActiveCell
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Activate
Loop
.Value = subcategory
End With

count1 = count1 - 1

If TDivisions = vbYes Then
GoTo divisionprocess
Else
GoTo Etiqueta_2
End If

Loop

If count1 = 0 Then
GoTo Etiqueta_1
Else
GoTo Etiqueta_2
End If

divisionprocess:

ActiveSheet.Range("E2").Activate

With ActiveCell
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Activate
Loop
End With

NDivision = InputBox("How many divisions are there? : ", "Number of Division")

count2 = NDivision

ActiveSheet.Range("F2").Activate

Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Activate
Loop

With ActiveCell
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Activate
Loop
.Value = NDivision
End With

Etiqueta_3:

If count2 = 0 Then
GoTo Etiqueta_2
End If

ActiveSheet.Range("E2").Activate

With ActiveCell
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Activate
Loop
End With

Do While count2 > 0

ActiveSheet.Range("E2").Activate

Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Activate
Loop

With ActiveCell
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Activate
Loop
End With

Division = InputBox("Enter the name of the Division : ", "Division")

TSDivision = MsgBox("Does this division Sub-Divisions?", vbYesNo + vbQuestion, "Sub-Divisions")

With ActiveCell
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Activate
Loop
.Value = Division
End With

count2 = count2 - 1

If TSDivision = vbYes Then
GoTo subdivisionprocess
Else
GoTo Etiqueta_3
End If

Loop

If count2 = 0 Then
GoTo Etiqueta_2
End If

subdivisionprocess:

ActiveSheet.Range("G2").Activate

Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Activate
Loop

With ActiveCell
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Activate
Loop
End With

NSDivision = InputBox("How many Sub-Divisions are there? : ", "Number of Sub-Division")

count3 = NSDivision

ActiveSheet.Range("H2").Activate

Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Activate
Loop

With ActiveCell
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Activate
Loop
.Value = NSDivision
End With

Do While count3 > 0

ActiveSheet.Range("G2").Activate

Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Activate
Loop

With ActiveCell
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Activate
Loop
End With

SubDivision = InputBox("Enter the name of the Sub-Division : ", "SubDivision")

With ActiveCell
Do While Not IsEmpty(ActiveCell)
.Offset(1, 0).Activate
Loop
.Value = SubDivision
End With

count3 = count3 - 1

Loop
If count3 = 0 Then
GoTo Etiqueta_3
End If

End Sub


este es el codigo de mi programa

[mrocf]

Hola! pjose07.
Respetuosamente te indico que tu macro es sumamente confusa, contiene innecesarios bucles de un solo paso, y no permite captar la idea de lo que pretendes.

Te sugiero -entonces- que subas a un server público como MediaFire (ó similar), un archivo con 3 hojas:
a) En la primera, con la estructura básica de tu hoja de trabajo;

b) En la segunda hoja, con algunos datos que -en apariencia- solicita el programa al usuario que ingrese

c) En la tercera (y de ser necesario), con los procesos finales que deseas realizar.

Es probable que de esta forma, se entienda tu dilema.
Saludos, Cacho.